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

I have a template workbook with tab names of "Extract 1, Extract 2, Extract 3" etc and a main Summary page that contains formulas that rely on all of these tabs. I also have a number of workbooks (22) that each contain one worksheet with a data extract in them. I need to be able to loop through these workbooks and copy the sheets over without the need to remove and insert a new tab (needs to use existing tabs). Initially I had this:

我有一个带有“提取1、提取2、提取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

but this only inserts new tabs and does not use the existing tab structure in place.

但是这只插入新的制表符，不使用现有的制表符结构。

Is there an easy way of doing this?

有简单的方法吗?

1 个解决方案

#1

Since the 22 workbooks only have 1 sheet, you don't need to loop through each of those sheets. Also, you can just copy the contains of the sheet onto whichever sheet you desire in your Mainbook.

因为22个工作簿只有一个工作表，所以您不需要对每个工作表进行循环。同样，你可以将表格的内容拷贝到你的主簿中你想要的任何一个表格上。

so replace,

所以取代,

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

With

与

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

Note: The use of .UsedRange assumes your data structure in each worksheet is the same as in the Extract sheets and that there are no merged cells.

注意:. usedrange假设每个工作表中的数据结构与提取表中的相同，并且没有合并单元格。

And assuming you that copy the first workbook to Extract 1 sheet and so on you can place a counter in your macro to paste each workbook into a different sheet.

假设你复制第一个工作簿来提取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

#1