8

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.

2
  • 2
    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)
    – jonsca
    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.
    – surfasb
    Jul 1, 2011 at 10:42

5 Answers 5

15

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
    Application.DisplayAlerts = False
    If ThisWorkbook.Sheets.Count < NUMBER_OF_SHEETS Then
        ThisWorkbook.Sheets.Add Count:=NUMBER_OF_SHEETS - ThisWorkbook.Sheets.Count
    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
    Application.DisplayAlerts = True

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


    ' Load the data
    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)
                externWorkbook.Sheets(i).Range("A1:" & GetTrueEnd(externWorkbook.Sheets(i)).Address).Copy ThisWorkbook.Sheets(i).Cells(mainLastEnd(i).Row, 1)

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

                ' Add file name heading
                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
            GetWorkbooks.Add xlFile
        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.

12
  • 1
    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.
    – Chris Kent
    Jul 4, 2011 at 9:38
  • It may help if you let me know the exact error message you get when it breaks.
    – Chris Kent
    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
2

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.

0

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.

4
  • 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.
    – Excellll
    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
0
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
1
  • 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.
    – Andi Mohr
    Jul 12, 2016 at 15:18
0

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

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

You must log in to answer this question.

Not the answer you're looking for? Browse other questions tagged .