Copy Data from multiple workbooks (each with multiple sheets) into a Masterfile with multiple sheets. Please help!

Manerlao

Board Regular
Joined
Apr 14, 2020
Messages
50
Office Version
  1. 2019
Platform
  1. Windows
Hi all,

I'm new to the forum and have a problem with my VBA code. Please could someone kindly provide some support with my VBA code, thank you. I have been trying for weeks.
Please see my details below:

Objective:
I have multiple workbooks (~50) each with 50 sheets of data. So these are my source workbooks.
I would like to copy/paste data from each of the sheets within the workbook into a Masterfile with the same sheet names. So this is my destination workbook.
Essentially, copy the data under the last row of each data row per sheet within my Masterfile.
I need the option to open the file first, so I can select it.

So basically I need to:
Copy data from range A2:[Last Column with data] in sheet1 of workbook1 into sheet 1 of Masterfile
Copy data from range A2:[Last Column with data] in sheet2 of workbook1 into sheet 2 of Masterfile
Copy data from range A2:[Last Column with data] in sheet50 of workbook1 into sheet 50 of Masterfile
....
Copy data from range A2:[Last Column with data] in sheet1 of workbook2 into sheet 1 of Masterfile
Copy data from range A2:[Last Column with data] in sheet2 of workbook2 into sheet 2 of Masterfile
Copy data from range A2:[Last Column with data] in sheet50 of workbook1 into sheet 50 of Masterfile
....
Copy data from range A2:[Last Column with data] in sheet1 of workbook50 into sheet 1 of Masterfile
Copy data from range A2:[Last Column with data] in sheet2 of workbook50 into sheet 2 of Masterfile
Copy data from range A2:[Last Column with data] in sheet50 of workbook50 into sheet 50 of Masterfile


Current Status:
So far, my code works very well to copy/paste data into one sheet for one workbook. But I need it to loop through all the sheets in the source and paste them into my Masterfile's corresponding sheets for multiple workbooks.
Please let me know your thoughts or if you need any further information. Thank you Excel community!

My code:

Sub IngestData()
Dim copiedData As Worksheet
Dim Masterfile As Worksheet
Dim lDestLastRow As Long
Dim lCopyLastRow As Long
Dim Ret1


' Get the file from my computer
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please select file")
If Ret1 = False Then Exit Sub

Set copiedData = Workbooks.Open(Ret1).Worksheets("Sheet1")
Set Masterfile = Workbooks("Masterfile").Worksheets("Sheet1")

'Find last used row in the copy range based on data in column A
lCopyLastRow = copiedData.Cells(copiedData.Rows.Count, "A").End(xlUp).Row
'Find first blank row in the destination range based on data in column A
'Offset property moves down 1 row

lDestLastRow = Masterfile.Cells(Masterfile.Rows.Count, "A").End(xlUp).Offset(1).Row

If copiedData.Range("A1") = "Date" Then
copiedData.Range("A2:zz" & lCopyLastRow).Copy _
Masterfile.Range("A" & lDestLastRow)

Workbooks.Open(Ret1).Close SaveChanges:=False

Else
Workbooks.Open(Ret1).Close SaveChanges:=False
MsgBox "No file has been specified. Sorry.", vbExclamation, "Tool"
End If

End Sub
 

Some videos you may like

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,746
Office Version
  1. 2013
Platform
  1. Windows
See if this is what you want:
VBA Code:
Sub t()
Dim fName As Variant, sh As Worksheet, wb As Workbook
CYCLE:
fName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", Title:="Please select a file")
    If fName = False Then Exit Sub
Set wb = Workbooks.Open(fName)
    For Each sh In ThisWorkbook.Sheets
        wb.Sheets(sh.Name).UsedRange.Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
    Next
    ans = MsgBox("Workbook " & Mid(fName, InStrRev(fName, "\") + 1) & " is complete.  Do you want to continue?", _
        vbYesNo, "CONTINUE?")
        wb.Close False
    If ans = vbYes Then GoTo CYCLE:
End Sub

Assumes Master workbook will host code.
 

Manerlao

Board Regular
Joined
Apr 14, 2020
Messages
50
Office Version
  1. 2019
Platform
  1. Windows
See if this is what you want:
VBA Code:
Sub t()
Dim fName As Variant, sh As Worksheet, wb As Workbook
CYCLE:
fName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", Title:="Please select a file")
    If fName = False Then Exit Sub
Set wb = Workbooks.Open(fName)
    For Each sh In ThisWorkbook.Sheets
        wb.Sheets(sh.Name).UsedRange.Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
    Next
    ans = MsgBox("Workbook " & Mid(fName, InStrRev(fName, "\") + 1) & " is complete.  Do you want to continue?", _
        vbYesNo, "CONTINUE?")
        wb.Close False
    If ans = vbYes Then GoTo CYCLE:
End Sub

Assumes Master workbook will host code.

Dear JLGWhiz,

This worked a real charm - such elegant code! Thank you so much! You're a genius :)
I'm now in the process of building this further so I can also capture some other aspects.
I'll share my progress!

Best regards
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,746
Office Version
  1. 2013
Platform
  1. Windows
Dear JLGWhiz,

This worked a real charm - such elegant code! Thank you so much! You're a genius :)
I'm now in the process of building this further so I can also capture some other aspects.
I'll share my progress!

Best regards
Glad you could use it,
regards, JLG
 

Manerlao

Board Regular
Joined
Apr 14, 2020
Messages
50
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Hi JLG, All!

I have a new problem :cry:

To summarise:
I now have a make a sub-masterfile per folder of my source data.
I need to make a 'sub-Masterfile' first before I can begin creating the 'top-level Masterfile', since some of the folders containing my workbook actually have multiple workbooks in them with the sheets. Not all my workbooks have the data aggregated into a single workbook it seems. Very challenging!
Please let me explain:

The Objective:

I have a Masterfile in Excel with the following sheet names:
Sheet1, Sheet 2, …, SheetN

I would like to copy/Paste data into the Masterfile [Destination] under each sheet from multiple workbooks [source] across different years of data.
Essentially, paste the data under the last row of each dataset per sheet within my Masterfile [Destination].
All the data in the [source] worksheets are within A2:[LastColumn and LastRow]
I need the option to open the file first, so I can select it. Same as before.

The [source] workbooks contain the following details/format:
Please note, the names of the workbooks are exactly the same as the sheet names. If this helps at all.

i.e.
Data in my 2015 folder:
The name of Workbook1 = “Sheet1_2015” as well.
The name of Workbook2 = “Sheet2_2015”


My data (all workbooks contain 1 unique sheet only).
Workbooks for 2015:

Workbook1 contains: Sheet1_2015
Workbook2 contains: Sheet2_2015

Workbook30 contains: Sheet30_2015

Workbooks for 2016:
Workbook1 contains: Sheet1_2016
Workbook2 contains: Sheet2_2016
...
Workbook30 contains: Sheet30_2016

Workbooks for 20XX
Workbook1 contains: Sheet1_20XX
Workbook2 contains: Sheet2_20XX

Workbook30 contains: Sheet30_20XX


As you can see, the sheet name per workbook has an additional year at the end. So the VBA needs to concatenate the worksheet name, lookup the sheet name in the Masterfile and paste it into the corresponding Masterfile sheet accordingly.
For example:
Data from A2:[LastColumn and LastRow] in 2016 workbook1 “Sheet1_2016” needs to be pasted into the Masterfile “Sheet1” under the last data in the sheet.
Data from A2:[LastColumn and LastRow] in 2019 workbook7 “Sheet7_2019” needs to be pasted into the Masterfile “Sheet7” under the last data in the sheet.

Data from A2:[LastColumn and LastRow] in 20XX workbookX “SheetX_20XX” needs to be pasted into the Masterfile “SheetX” under the last data in the sheet.


Please could someone help? I spent the whole night/morning adjusting the code that JLG kindly sent me, but all my VBA failed.
Thank you.

Kind regards
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,746
Office Version
  1. 2013
Platform
  1. Windows
It woud probably be better if you start a new thread so the new issue will be transparent to other members.
 

Manerlao

Board Regular
Joined
Apr 14, 2020
Messages
50
Office Version
  1. 2019
Platform
  1. Windows
Thank
It woud probably be better if you start a new thread so the new issue will be transparent to other members.
Thank you very much JLG, I have taken your advice and started a new thread.
Appreciate your guidance.

Thank you and kind regards,
M.
 

Watch MrExcel Video

Forum statistics

Threads
1,118,756
Messages
5,574,049
Members
412,565
Latest member
roberttaekim
Top