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​

 

[RatExcel]

Try this:

Public Sub Combine_Reports()

Set wb = Workbooks(ThisWorkbook.Name)

sReportsDir = "C:\Users\Username\Desktop\Reports\"

Application.ScreenUpdating = False

Call One_Rep_At_a_Time("HK", sReportsDir)
Call One_Rep_At_a_Time("TOK", sReportsDir)
Call One_Rep_At_a_Time("ASIA", sReportsDir)
Call One_Rep_At_a_Time("LON", sReportsDir)

Application.DisplayAlerts = False
wb.Worksheets(1).Delete
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, Dir)

sFileName = Reg & Space(1) & Format(Date, "YYYY-MM-DD") & ".xls"
sRegPath = Dir & sFileName

Workbooks.Open sRegPath

Set wbReg = Workbooks(sFileName)

wbReg.Worksheets(Reg).Copy After:=Workbooks(ThisWorkbook.Name).Sheets(Sheets.Count)

wbReg.Close False

End Sub

Create new .xlsm file with only one sheet in it, copy above code to new module, create new button on Sheet1 and assign Combine_Reports sub to it

 

[hems1011]

Hia,

Im getting Runtime error 9 (Subscript out of range) while running the code

Set wb = Workbooks(ThisWorkbook.Name)
sReportsDir = "C:\TESTER\"
Application.ScreenUpdating = False
Call One_Rep_At_a_Time("HK", sReportsDir)
Call One_Rep_At_a_Time("TOK", sReportsDir)
Call One_Rep_At_a_Time("ASIA", sReportsDir)
Call One_Rep_At_a_Time("LON", sReportsDir)
Application.DisplayAlerts = False
wb.Worksheets(1).Delete
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, Dir)
sFileName = Reg & Space(1) & Format(Date, "YYYY-MM-DD") & ".xls"
sRegPath = Dir & sFileName
Workbooks.Open sRegPath
Set wbReg = Workbooks(sFileName)
wbReg.Worksheets(Reg).Copy After:=Workbooks(ThisWorkbook.Name).Sheets(Sheets.Count)
wbReg.Close False
End Sub

 

[Teeroy]

Some questions:
What line are you getting an error on?
Ratexcel's code assumes the sheet name is the Region ("HK" etc.), is that correct?
Is there only one sheet in each workbook you want to combine?

BTW I wouldn't use DIR as a variable name as it is the name of a VBA function.

 

[hems1011]

I get the Error on the below line

wbReg.Worksheets(Reg).Copy After:=Workbooks(ThisWorkbook.Name).Sheets(Sheets.Count)

Ratexcel's code assumes the sheet name is the Region ("HK" etc.), is that correct?
The sheet name is "HK 2014-08-27" since we create the sheet everyday we rename it with the same days date

Is there only one sheet in each workbook you want to combine?
Yes, one tab in all 4 workbooks. Say 'Sheet1' of all the books


Thank You

 

[Teeroy]

Try changing the line causing the error to:

wbReg.Worksheets(1).Copy After:=ThisWorkbook.Sheets(Sheets.Count)

 

[hems1011]

The new code which is as belows does work .. However, when I click to Run macro on my newely created Macro Sheet gets replaced with the 4 files that Im looking to comibe

For example:- macro sheet has only one sheet in it with a macro button
I click on the macro button and the macro runs and combines 4 files into 1, thus replacing my macro sheet 1

Can we have something where in once i click the macro
1) A new workbook should open up with those 4 files in it
2) The tabs gets renamed as HK TOK LON ASIA respectively instead if Sheet1, Sheet1 (2), Sheet1 (3), Sheet1 (4)
3)It gets auto saved on the same drive where the previous files were opened from with a NEW FILE NAME and todays date. For ex: "Consolidated report as on 2014-08-27"

</SPAN></SPAN>
Public Sub Combine_Reports()</SPAN></SPAN>
Set wb = Workbooks(ThisWorkbook.Name)</SPAN></SPAN>
sReportsDir =   'path</SPAN></SPAN>
Application.ScreenUpdating = False</SPAN></SPAN>
Call One_Rep_At_a_Time("Tok", sReportsDir)
Call One_Rep_At_a_Time("Asia", sReportsDir)
Call One_Rep_At_a_Time("HK", sReportsDir)
Call One_Rep_At_a_Time("Lon", sReportsDir)</SPAN></SPAN>
Application.DisplayAlerts = False
wb.Worksheets(1).Delete
wb.SaveAs sReportsDir & "Daily Reports" & Space(1) & Format(Date, "YYYY-MM-DD") & ".xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
Application.ScreenUpdating = True</SPAN></SPAN>
End Sub</SPAN></SPAN>

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

 

[Teeroy]

You should save the macro workbook before you try to run the macro and when it saves it will save as another filename.

 

[hems1011]

I created a macro on a new work book. Labelled it as MACRO WORKBOOK. Closed it

Now I need to run this macro.

I reopen the same workbook

Click on Run macro

The macro runs but now instead of having 5 tabs in it (1 coversheet which has my macro button, and 4 merged files) it just has 4 tabs (merged files)

Where am I going wrong please?

 

[RatExcel]

Why do you need this sheet with macro button in your consolidated report?