将工作表从多个工作簿复制到不同工作簿中的现有工作表中

我有一个标签名称为“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张工作表，因此您无需遍历每个工作表。 此外，您可以将表单的内容复制到您的主簿中所需的任何表单中。

所以replace，

  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工作表等等，您可以在macros中放置一个计数器，将每个工作簿粘贴到另一个工作表中。

 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