将工作表从多个工作簿复制到另一个工作簿中的现有工作表

Question

我有一个模板工作簿，其标签名称为“ Extract 1，Extract 2，Extract 3”等，其主摘要页面包含依赖于所有这些标签的公式。 我也有许多工作簿（22），每个工作簿都包含一个工作表，其中包含数据提取。 我需要能够遍历这些工作簿并复制工作表，而无需删除并插入新的选项卡（需要使用现有的选项卡）。 最初我有这个：

    Sub GetSheets()
Path = "C:\Users\hill\Desktop\Summary Doc Output Files\Summary Doc Output Files\"
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
 Dim x As Integer

End Sub

但这只会插入新的标签，而不会使用现有的标签结构。

有一个简单的方法吗？

Answer 1

由于22个工作簿只有1个工作表，因此您无需循环浏览每个工作表。 同样，您可以将表格的内容复制到您希望在Mainbook中使用的任何表格上。

所以更换

  For Each Sheet In ActiveWorkbook.Sheets
     Sheet.Copy After:=ThisWorkbook.Sheets(1)
  Next Sheet

同

ThisWorkbook.Sheets("Extract 1").UsedRange.Value = ActiveWorkbook.Sheets(1).UsedRange.Value

注意： .UsedRange的使用假定每个工作表中的数据结构与“ Extract表中的数据结构相同，并且没有合并的单元格。

并假设您将第一个工作簿复制到“ Extract 1张工作表”，依此类推，您可以在宏中放置一个计数器，将每个工作簿粘贴到另一张工作表中。

Sub GetSheets()
Dim x As Integer, wb as Workbook

Path = "C:\Users\hill\Desktop\Summary Doc Output Files\Summary Doc Output Files\"

Filename = Dir(Path & "*.xls")

x = 1
Do While Filename <> ""

    Set wb = Workbooks.Open Filename:=Path & Filename, ReadOnly:=True

    ThisWorkbook.Sheets("Extract " & x).UsedRange.Value = wb.Sheets(1).UsedRange.Value    

    wb.Close false

    x = x + 1

    Filename = Dir()

Loop


End Sub