将文件夹中所有工作簿的活动工作表复制到新工作簿

Question

Hi I have the following code to copy all worksheets of all workbooks in a given folder to a single workbook. I need to modify this code to copy only the active sheet on all workbooks (now it copies all the sheets). Can you help me with this?

Option Explicit

Sub CombineFiles()

Dim Path            As String
Dim FileName        As String
Dim Wkb             As Workbook
Dim WS              As Worksheet

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Path = "C:\" 'Change as needed
    FileName = Dir(Path & "\*.xlsx", vbNormal)
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
        For Each WS In Wkb.Worksheets
            WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Next WS
        Wkb.Close False
        FileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Answer 1

This way you can do what you want:

Option Explicit

Sub CombineFiles()

Dim Path            As String
Dim FileName        As String
Dim Wkb             As Workbook
Dim WS              As Worksheet

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Path = "C:\" 'Change as needed
    FileName = Dir(Path & "\*.xlsx", vbNormal)
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)

        ActiveSheet.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        'For Each WS In Wkb.Worksheets
        '    WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        'Next WS
        Wkb.Close False
        FileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Note:

When you open the workbook, you go over all the sheets with the FOR LOOP , but you only need to copy the ActiveSheet then (as you said) you only need to copy to the new Wrokbook