Question

我希望有人能够提供帮助。

我正在考虑将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始终引用正在运行的代码所在的工作簿，因此不需要任何引用它的Workbook类型变量

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

按选项卡名称合并工作簿

2 个答案: