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

嗨我有以下代码将给定文件夹中的所有工作簿的所有工作表复制到一个工作簿。 我需要修改此代码以仅复制所有工作簿上的活动工作表（现在它复制所有工作表）。 你能帮我吗？

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