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然后（如您所说）您只需要复制到新工作表{ {1}}

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

1 个答案: