Excel VBA：在一个文件夹中的多个工作簿上循环工作表的简单副本

Question

I'm attempting to apply a macro that would copy and paste one specific worksheet (call the title of that worksheet "x") from one workBOOK ("x1") , onto a master workBOOK (call that workBOOK "xmaster"), after it copy and pastes the worksheet from workbook x1 it should also rename the title of the worksheet "x" to cell B3. This should be done before it moves to the next workbook.

It would need to do this for workBOOK x1 through, say, x100. I cannot refer to the workbook by name though, because they are each named a string of text that is in no real sortable method.

This code I know works, copying "x" from "x1" to "xmaster", along with renaming the sheet, and breaking the links, is the following:

    Sub CombineCapExFiles()
    Sheets("Capital-Projects over 3K").Move After:=Workbooks("CapEx Master File.xlsm").Sheets _
        (3)
    ActiveSheet.Name = Range("B3").Value

    Application.DisplayAlerts = False

For Each wb In Application.Workbooks
    Select Case wb.Name
            Case ThisWorkbook.Name, "CapEx Master File.xlsm"
                ' do nothing
            Case Else
                  wb.Close
    End Select
Next wb

    Application.DisplayAlerts = True

End Sub

The Activate Previous window isn't working, also not sure how to fix that portion of it.

I'm not sure how to build this to loop through all workBOOKs in the directory, however.

Should I use this:?

MyPath = "C:\directory here"
strFilename = Dir(MyPath & "\*.xlsx", vbNormal) 'change to xlsm if needed ?

If Len(strFilename) = 0 Then Exit Sub ' exit if no files in folder

Do Until strFilename = ""
    'Your code here
    strFilename = Dir()    
Loop

An additional constraint is that it needs to not run the macro on xmaster (it will have an error because it will not have the sheet "x" which will be renamed from the previous workbooks.)

Thanks! Matthew

Answer 1

like this? (not tested)

Option Explicit

Sub LoopFiles()

Dim strDir As String, strFileName As String
Dim wbCopyBook As Workbook
Dim wbNewBook As Workbook
Dim wbname as String   

strDir = "C:\"
strFileName = Dir(strDir & "*.xlsx")

Set wbNewBook = Workbooks.Add 'instead of adding a workbook, set = to the name of your master workbook
wbname = ThisWorkbook.FullName

 Do While strFileName <> ""
    Set wbCopyBook = Workbooks.Open(strDir & strFileName)
    If wbCopyBook.FullName <> wbname Then
        wbCopyBook.Sheets(1).Copy Before:=wbNewBook.Sheets(1)
        wbCopyBook.Close False
        strFileName = Dir()
    Else
        strFileName = Dir()
    End If
Loop

End Sub

Answer 2

This bit will work to avoid running the macro on xmaster.

xmaster = "filename for xmaster"
MyPath = "C:\directory here"
strFilename = Dir(MyPath & "\*.xls*", vbNormal) 'this will get .xls, .xlsx, .xlsm and .xlsb files
If Len(strFilename) = 0 Then Exit Sub ' exit if no files in folder

Do Until strFilename = ""
    If strFileName = xmaster Then ' skip the xmaster file
        strFilename = Dir() 
    End If
    'Your code here
    strFilename = Dir()    
Loop

I can't help on the other part though. I don't see any Activate Previous window part in your code.