按标签名称合并工作簿

我希望有人能够帮助。

我正在考虑在excel中合并几个工作簿，但每个工作簿都有8-10个选项卡，我不需要，而实际上我只需要一个选项卡，我已经将以下公式组合在一起了，但我不确定是什么要做的只是将我需要的单个选项卡组合在一起，它们在每个工作簿中都是相同的名称。

Sub GetSheets() Path = "C:\Users\dt\Desktop\dt kte\" Filename = Dir(Path & "*.xls") Do While Filename <> "" Workbooks.Open Filename:=Path & Filename, ReadOnly:=True For Each Sheet In ActiveWorkbook.Sheets Sheet.Copy After:=ThisWorkbook.Sheets(1) Next Sheet Workbooks(Filename).Close Filename = Dir() Loop End Sub 

谢谢

Answer 1

它是有意识地使用臭名昭着的 On Error Resume Next语句并避免在一个集合中循环的情况之一（即Worksheets一）

此外， ThisWorkbook总是引用运行代码所在的工作簿，所以不需要任何引用它的Workbooktypesvariables

 Sub GetSheets() Path = "C:\Users\dt\Desktop\dt kte\" Filename = Dir(Path & "*.xls") On Error Resume Next Do While Filename <> "" Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True).Worksheets("SHEETNAME").Copy After:=ThisWorkbook.Sheets(1) ActiveWorkbook.Close False Filename = Dir() Loop End Sub 

只需将SHEETNAME更改为您实际需要的选项卡名称即可

Answer 2

如果你只需要从每一个复制特定的表格，下面应该工作（只需调整SHEETNAME到什么）

 Sub GetSheets() dim mainWB as Workbook Set mainWB = ThisWorkbook Path = "C:\Users\dt\Desktop\dt kte\" Filename = Dir(Path & "*.xls") Do While Filename <> "" Workbooks.Open Filename:=Path & Filename, ReadOnly:=True For Each Sheet In ActiveWorkbook.Sheets If sheet.Name = "SHEETNAME" then Sheet.Copy After:=mainWB.Sheets(1) End if Next Sheet Workbooks(Filename).Close Filename = Dir() Loop End Sub