How can I merge hundreds of Excel spreadsheet files?

I have hundreds of excel files which are all of the same format (i.e. 4 worksheets per Excel file). I need to combine all the files into 1 all singing and dancing file which must have the same format as the originals (i.e. maintain the four separate worksheets, which are all identically named).

While each file is structured the same, the number of columns (and the heading names) between sheet 1 and 2 (for example) is different. So it can’t be combined into one file with everything in one sheet!

There are two complications:

1. I need to create an EXTRA column in the merged file (on EACH sheet) to identify the source file (“file name”).

2. The files contain a lot of zero data entries (e.g. 55 rows of useful data followed by hundreds of rows of zeros) which I need to remove from the merged file.

I’ve never used VBA, but everyone has to start somewhere I suppose.

• A decent way to start in VBA is to begin by recording your macros (hit record, do your mainipulations, and then stop) and viewing the code associated with them (just a tip, not recommending you do this to solve your problem) Jul 1, 2011 at 9:48
• Or just beg the MVPs at answers.microsoft.com. Probably the best way to do it would be to post example templates of what you are starting with and how you want it to look at the end, making sure you mark exactly how you want to format the columns. The more prep work, the better. That way you aren't rewriting several lines due to badly written specs. Jul 1, 2011 at 10:42

That is a mighty request you have, but I had an evening to burn so here is some code that I think will work. (Not knowing the formats of your sheets doesn't help, but we can work from this.)

Open a new workbook (this will be your master workbook), go to the VBA environment (Alt + F11) and create a new module (Insert > Module). Paste the following VBA code into the new module window:

Option Explicit
Const NUMBER_OF_SHEETS = 4

Public Sub GiantMerge()
Dim externWorkbookFilepath As Variant
Dim externWorkbook As Workbook
Dim i As Long
Dim mainLastEnd(1 To NUMBER_OF_SHEETS) As Range
Dim mainCurEnd As Range

Application.ScreenUpdating = False

' Initialise

' Correct number of sheets
If ThisWorkbook.Sheets.Count < NUMBER_OF_SHEETS Then
ElseIf ThisWorkbook.Sheets.Count > NUMBER_OF_SHEETS Then
For i = ThisWorkbook.Sheets.Count To NUMBER_OF_SHEETS + 1 Step -1
ThisWorkbook.Sheets(i).Delete
Next i
End If

For i = 1 To NUMBER_OF_SHEETS
Set mainLastEnd(i) = GetTrueEnd(ThisWorkbook.Sheets(i))
Next i

For Each externWorkbookFilepath In GetWorkbooks()
Set externWorkbook = Application.Workbooks.Open(externWorkbookFilepath, , True)

For i = 1 To NUMBER_OF_SHEETS

If mainLastEnd(i).Row > 1 Then
' There is data in the sheet

' Copy new data (skip headings)
externWorkbook.Sheets(i).Range("A2:" & GetTrueEnd(externWorkbook.Sheets(i)).Address).Copy ThisWorkbook.Sheets(i).Cells(mainLastEnd(i).Row + 1, 1)

' Find the end column and row
Set mainCurEnd = GetTrueEnd(ThisWorkbook.Sheets(i))
Else
' No nata in sheet yet (prob very first run)

' Get correct sheet name from first file we check
ThisWorkbook.Sheets(i).Name = externWorkbook.Sheets(i).Name

' Copy new data (with headings)

' Find the end column and row
Set mainCurEnd = GetTrueEnd(ThisWorkbook.Sheets(i)).Offset(, 1)

ThisWorkbook.Sheets(i).Cells(1, mainCurEnd.Column).Value = "File Name"
End If

' Add file name into extra column
ThisWorkbook.Sheets(i).Range(ThisWorkbook.Sheets(i).Cells(mainLastEnd(i).Row + 1, mainCurEnd.Column), mainCurEnd).Value = externWorkbook.Name

Set mainLastEnd(i) = mainCurEnd
Next i

externWorkbook.Close
Next externWorkbookFilepath

Application.ScreenUpdating = True
End Sub

' Returns a collection of file paths, or an empty collection if the user selects cancel
Private Function GetWorkbooks() As Collection
Dim fileNames As Variant
Dim xlFile As Variant

Set GetWorkbooks = New Collection

fileNames = Application.GetOpenFilename(Title:="Please choose the files to merge", _
FileFilter:="Excel Files, *.xls;*.xlsx", _
MultiSelect:=True)
If TypeName(fileNames) = "Variant()" Then
For Each xlFile In fileNames
Next xlFile
End If
End Function

' Finds the true end of the table (excluding unused columns/rows and rows filled with 0's)
Private Function GetTrueEnd(ws As Worksheet) As Range
Dim lastRow As Long
Dim lastCol As Long
Dim r As Long
Dim c As Long

On Error Resume Next
lastCol = ws.UsedRange.Find("*", , , xlPart, xlByColumns, xlPrevious).Column
lastRow = ws.UsedRange.Find("*", , , xlPart, xlByRows, xlPrevious).Row
On Error GoTo 0

If lastCol <> 0 And lastRow <> 0 Then

' look back through the last rows of the table, looking for a non-zero value
For r = lastRow To 1 Step -1
For c = 1 To lastCol
If ws.Cells(r, c).Text <> "" Then
If ws.Cells(r, c).Text <> 0 Then
Set GetTrueEnd = ws.Cells(r, lastCol)
Exit Function
End If
End If
Next c
Next r
End If

Set GetTrueEnd = ws.Cells(1, 1)
End Function


Save it, and we're ready to start using it.

Run the macro GiantMerge. You have to select the excel files you want to merge (you can select multiple files with the dialogue box, in the usual windows way (Ctrl to select multiple individual files, Shift to select a range of files)). You don't have to run the macro on all the files you want to merge, you can do it on just a few at a time. The first time you run it, it will configure your master workbook to have the correct number of sheets, name the sheets based on the first workbook you selected to merge, and add in the headings.

I've made the following assumptions (not a complete list):

• There are 4 sheets (This can be easily changed by changing the constant at the top of the code.)
• The sheets are in the same order in all the extra workbooks
• The columns in each sheet are in the same order in all workbooks (though not all sheets in a work book will have the same columns. e.g. WorkBook1, Sheet1 has columns A, B, C, Sheet2 has columns A, B; WorkBook2, Sheet1 has columns A, B, C, Sheet2 has columns A, B. Etc. If a workbook has the following: Sheet1 has columns A, C, B, Sheet2 has columns B, A then the columns will not be aligned correctly)
• There are no extra or missing columns in the extra workbooks
• There is a heading row in every sheet in each workbook (and it is in the first row on each sheet only)
• All columns should be included (even if they only contain 0's)
• All rows at the end of a table containing only 0's are not copied to the master
• It is only the file name (and not file path) that you need in the extra column
• I don't know how well it'll work if you don't have any data in some of the sheets (or they're just filled with zeros)

Hope this helps.

• Absolute Genius!! It added the file names at the right place, and removed the surplus data from 2 of the four worksheets. I’m sure it would have done everything given the chance but fell over at the final hurdle at: [If ws.Cells(r, c) <> 0 Then] The only reason I can think of is that the sheets that worked contained raw data (hard numbers), dates, and no formulas. The two that didn’t had formulas linked to the other sheets. I don’t know if this is relevant but it’s the only real difference between the information in the worksheets. What do I do to fix it? Many thanks Jul 4, 2011 at 8:27
• @Jonathan de Mille, try changing If ws.Cells(r, c) <> 0 Then to If ws.Cells(r, c).Value <> 0 Then. I've updated my code in the answer above. But I can't test this as I'm in work now. If it doesn't work I'll have another look tonight when I get home. Jul 4, 2011 at 9:38
• It may help if you let me know the exact error message you get when it breaks. Jul 4, 2011 at 9:52
• @ Phydaux. Hi, If I only select 1 file it runs without an error. If I select two files then it falls over at point above. I think this is because where the sheets have raw data it correctly identifies the zero data point, but it doesn’t on the sheets which have formulas linked to the raw data. As it happens, if just one ‘specific’ worksheet from the workbook could be selected (e.g. XXX-Raw say), then the point at which the zero's can be discarded would be the same for all 4 sheets in that workbook. Ps: I did try the .value change but the result was the same. Hope this helps. Many thanks. Jul 4, 2011 at 14:27
• @ Phydaux. By the way the error message is runtime error ‘13’ Type incompatible. Many thanks. Jul 4, 2011 at 14:37

It's also worth mentioning that Ron de Bruin has created a fabulous Windows plugin for merging Excel worksheets, called RDBMerge. Instructions can be found here: http://www.rondebruin.nl/merge.htm. It worked flawlessly for me, merging xlsx files in Excel 2007.

It does create an extra column in the merged file containing the name of the source file. Not sure how it handles zero data entries (second part of original question), though.

This is a decent size project, but very doable. Here's a good start on the VBA that you can build on. This will allow you to go through all the files you need to merge if you have them (alone) in one folder. The master workbook you are merging into should NOT be in this directory.

Option Explicit
Sub giantmerge()
Dim f As Object, fso As Object
Dim folder As String
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Dim sn1 As String, sn2 As String, sn3 As String, sn4 As String
Set wb = ThisWorkbook
'Change sheet names to match those in your workbooks.
sn1 = "Sheet1"
sn2 = "Sheet2"
sn3 = "Sheet3"
sn4 = "Sheet4"
Set ws1 = wb.Sheets(sn1)
Set ws2 = wb.Sheets(sn2)
Set ws3 = wb.Sheets(sn3)
Set ws4 = wb.Sheets(sn4)

Set fso = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Cancel Selected"
End
End If
folder = .SelectedItems(1)
End With
For Each f In fso.GetFolder(folder).Files
Workbooks.Open Filename:=f.Path
'Get data and store in temporary arrays.
Workbooks(f.Name).Close
'Input data in this workbook (master).
Next
End Sub


Now, you (or someone else) can supply the code for the For loop at the end. Hope this helps.

• Many thanks, it all means gobbledygook to me at the moment, but I'll give it a go. Jul 2, 2011 at 10:31
• Showing my inexperience now, when I tried this I got a run time failure on the line -> Set ws1 = wb.Sheets(sn1) along with a message "Index out of range". Is there something I have missed? Jul 2, 2011 at 10:48
• Did you change the sheet names to match the sheets in your workbook? You need to change the line: sn1 = "Sheet1" to: sn1 = "<your sheet name>", and so on for the other sheet objects. Jul 2, 2011 at 21:44
• Hi, I did change the worksheet names etc, but still couldn't get past the index out of range error. Jul 4, 2011 at 8:01
Sub simpleXlsMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")

' change folder path of excel files here
Set dirObj = mergeObj.Getfolder("D:\change\to\excel\files\path\here")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

' change "A2" with cell reference of start point for every files here
' for example "B3:IV" to merge all files start from columns B and rows 3
' If you're files using more than IV column, change it to the latest column
' Also change "A" column on "A65536" to the same column as start point
Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate

' Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next
End Sub

• Welcome to SuperUser. What does this code do that the other VBA answers posted don't do? Always best to introduce your code with an explanation and description rather than just posting a code block. Jul 12, 2016 at 15:18

Method using a simple python script (much shorter than VB!).

https://superuser.com/a/1138948/141182