Macro to combine multiple workbooks into a single workbook

[hems1011]

Hi,

I saw few codes on the net but it didn't work fine for me hence thought of dropping in a note here. Any advise/tip would be of great help

Im looking for a macro that will help me combine multiple workbooks into a New workbook and which can get save on my sharedrive with new name

Bascially, in the morning we run reports for 4 regions (HK, TOK, ASIA,LON) and save the file with todays date. So for example: "Tok 2014-08-26.xls" would be the file name for the Tok region. End of the day I need to combine all of these 4 regions data into a new report all togther. This new report is called as "Daily Reports 2014-08-26.xls"which contains 4 new tabs in the sheet. (i.e the data from HK, TOK, ASIA,LON tabs)

I need a VBA that once clicked can help me create my new sheet ie "Daily Reports 2014-08-26.xls" and than gets saved in our Share drive.

Thank You​

 

[hems1011]

I need this so that I can link this macro to my other macro sheet.

which means
I have a different macro all together and want to club this (which we are trying to figure out) with that one

have 3 steps to that main macro

1 step wil clean and process X data and save the file in the preferred folder

2 step should be that it merges the 4 files and saves the new mergerd report to share drive with a New name and todays date

3 and last step is when the button is clicked it sends an email out these 2 newly created files

I am good with 1st and 3rd step..

2nd step is where i am fixed at... Your code is very good only if it could help me now to not replace sheet it would be awsum

Please suggest ur expertise

Cheers

 

[Teeroy]

Try saving to a new file instead. Adapting RatExcel's code;

Public Sub Combine_Reports()
Set wb = Workbooks.Add
iNewSheets = wb.Sheets.Count
sReportsDir = "C:\TESTER\"  'path
Application.ScreenUpdating = False
Call One_Rep_At_a_Time("Tok", sReportsDir, wb)
Call One_Rep_At_a_Time("Asia", sReportsDir, wb)
Call One_Rep_At_a_Time("HK", sReportsDir, wb)
Call One_Rep_At_a_Time("Lon", sReportsDir, wb)
Application.DisplayAlerts = False
For i = iNewSheets to 1 Step -1
    wb.Worksheets(i).Delete
Next i
wb.SaveAs sReportsDir & "Daily Reports" & Space(1) & Format(Date, "YYYY-MM-DD") & ".xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Public Sub One_Rep_At_a_Time(Reg As String, Dir As String, wb As Workbook)
sFileName = Reg & Space(1) & Format(Date, "YYYY-MM-DD") & ".xls"
sRegPath = Dir & sFileName
Workbooks.Open sRegPath
Set wbReg = Workbooks(sFileName)
wbReg.Worksheets(1).Copy After:=wb.Sheets(Sheets.Count)
wbReg.Close False
End Sub

 

[hems1011]

Nope. This doesnt work
Getting Error

Complie Error
ByRef argument type mismatch

 

[Teeroy]

D'oh! Your variables are not defined as a type so they are Variants by default. Add immediately after the first line;

Dim sReportsDir as string
Dim wb as Workbook

 

[RatExcel]

You could also add new line to rename the worksheets from Sheet1 to proper names:

Public Sub Combine_Reports()
Set wb = Workbooks.Add
iNewSheets = wb.Sheets.Count
sReportsDir = "C:\TESTER\"  'path
Application.ScreenUpdating = False
Call One_Rep_At_a_Time("Tok", sReportsDir, wb)
Call One_Rep_At_a_Time("Asia", sReportsDir, wb)
Call One_Rep_At_a_Time("HK", sReportsDir, wb)
Call One_Rep_At_a_Time("Lon", sReportsDir, wb)
Application.DisplayAlerts = False
For i = iNewSheets to 1 Step -1
    wb.Worksheets(i).Delete
Next i
wb.SaveAs sReportsDir & "Daily Reports" & Space(1) & Format(Date, "YYYY-MM-DD") & ".xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Public Sub One_Rep_At_a_Time(Reg As String, Dir As String, wb As Workbook)
sFileName = Reg & Space(1) & Format(Date, "YYYY-MM-DD") & ".xls"
sRegPath = Dir & sFileName
Workbooks.Open sRegPath
Set wbReg = Workbooks(sFileName)
[COLOR=#ff0000][B]wbReg.Worksheets(1).Name = Reg[/B][/COLOR]
wbReg.Worksheets([B][COLOR=#ff0000]Reg[/COLOR][/B]).Copy After:=wb.Sheets(Sheets.Count)
wbReg.Close False
End Sub

 

[hems1011]

Thos does work, but now instead of 4 only 2 sheets are getting created..
ie Tok and LON. Below is the final code im using.

Also, this doesnt save the new file in the same folder as "Daily Reports" & Space(1) & Format(Date, "YYYY-MM-DD") at all even though the code says so

Public Sub Combine_Reports()
Dim sReportsDir As String
Dim wb As Workbook
Set wb = Workbooks.Add
iNewSheets = wb.Sheets.Count
sReportsDir = "C:\TESTER\"
Application.ScreenUpdating = False
Call One_Rep_At_a_Time("LON", sReportsDir, wb)
Call One_Rep_At_a_Time("TOK", sReportsDir, wb)
Call One_Rep_At_a_Time("HK", sReportsDir, wb)
Call One_Rep_At_a_Time("ASIA", sReportsDir, wb)
Application.DisplayAlerts = False
For i = iNewSheets To 1 Step -1
    wb.Worksheets(i).Delete
Next i
wb.SaveAs sReportsDir & "Daily Reports" & Space(1) & Format(Date, "YYYY-MM-DD") & ".xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Public Sub One_Rep_At_a_Time(Reg As String, Dir As String, wb As Workbook)
sFileName = Reg & Space(1) & Format(Date, "YYYY-MM-DD") & ".xls"
sRegPath = Dir & sFileName
Workbooks.Open sRegPath
Set wbReg = Workbooks(sFileName)
wbReg.Worksheets(1).Name = Reg
wbReg.Worksheets(Reg).Copy After:=wb.Sheets(Sheets.Count)
wbReg.Close False
End Sub

 

[hems1011]

Your code is really helpful

I changed few things. Now this works as per my need.

Just Perfect.

Thank You for all your patience

Public Sub Combine_Reports()
Dim sReportsDir As String
Dim wb As Workbook
Set wb = Workbooks.Add
iNewSheets = wb.Sheets.Count
sReportsDir = "C:\TESTER\"
Application.ScreenUpdating = False
Call One_Rep_At_a_Time("LON", sReportsDir, wb)
Call One_Rep_At_a_Time("TOK", sReportsDir, wb)
Call One_Rep_At_a_Time("HK", sReportsDir, wb)
Call One_Rep_At_a_Time("ASIA", sReportsDir, wb)
Application.DisplayAlerts = False
wb.Worksheets(1).Delete
wb.Worksheets(5).Delete
wb.Worksheets(5).Delete
wb.SaveAs "C:\TESTER\Daily Reports" & Space(1) & Format(Date, "YYYY-MM-DD") & ".xls"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Public Sub One_Rep_At_a_Time(Reg As String, Dir As String, wb As Workbook)
sFileName = Reg & Space(1) & Format(Date, "YYYY-MM-DD") & ".xls"
sRegPath = Dir & sFileName
Workbooks.Open sRegPath
Set wbReg = Workbooks(sFileName)
wbReg.Worksheets(1).Name = Reg
wbReg.Worksheets(Reg).Copy After:=wb.Sheets(Sheets.Count)
wbReg.Close False
End Sub

 

[Teeroy]

I think found the problem in the last code that was causing the sheets to go into the wrong position. Try:

Public Sub Combine_Reports()
Dim sReportsDir As String
Dim wb As Workbook
Set wb = Workbooks.Add
iNewSheets = wb.Sheets.Count
sReportsDir = "C:\TESTER\"
Application.ScreenUpdating = False
Call One_Rep_At_a_Time("LON", sReportsDir, wb)
Call One_Rep_At_a_Time("TOK", sReportsDir, wb)
Call One_Rep_At_a_Time("HK", sReportsDir, wb)
Call One_Rep_At_a_Time("ASIA", sReportsDir, wb)
Application.DisplayAlerts = False
For i = iNewSheets To 1 Step -1
    wb.Worksheets(i).Delete
Next i
wb.SaveAs sReportsDir & "Daily Reports" & Space(1) & Format(Date, "YYYY-MM-DD") & ".xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Public Sub One_Rep_At_a_Time(Reg As String, Dir As String, wb As Workbook)
sFileName = Reg & Space(1) & Format(Date, "YYYY-MM-DD") & ".xls"
sRegPath = Dir & sFileName
Workbooks.Open sRegPath
Set wbReg = Workbooks(sFileName)
wbReg.Worksheets(1).Name = Reg
wbReg.Worksheets(Reg).Copy After:=wb.Sheets(wb.Sheets.Count)
wbReg.Close False
End Sub

 

[hems1011]

Thanks Mate for all the help
This does work without any Glitch

Have a super rocking day ahead

Cheers

 

[Teeroy]

Happy to have helped .