Copying worksheets from multiple workbooks into existing worksheets in a different workbook

Question

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:

    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?

Scott Holtzman Scott Holtzman · Accepted Answer · 2015-11-03T13:52:26

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.

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.

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.

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

Copying worksheets from multiple workbooks into existing worksheets in a different workbook

1 Answers