將文件夾中所有工作簿的活動工作表復制到新工作簿

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