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

Question

您好，我有以下代码将给定文件夹中所有工作簿的所有工作表复制到单个工作簿。我需要修改此代码以仅复制所有工作簿上的活动工作表（现在它复制所有工作表）。你能帮我解决这个问题吗？

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

这样你就可以为所欲为：

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

注意：

当您打开工作簿时，您会遍历所有带有FOR LOOP 的工作表，但您只需复制ActiveSheet 然后（如您所说）您只需复制到新的Wrokbook