VBA to merge multiple workbooks with demarcation

  • Pls, I need help on how to merge multiple excel workbooks into single worksheet but with demarcation. I mean I want to know where one workbook data starts and ends, preferably filling the entire first column with workbook name.

    What this mean is that as each workbook is copying to the new worksheet, it will pick its workbook name and use it to fill entire first column in the new worksheet and do that to all workbooks.
    I had tried the code below before but I was giving me 'compile error: Label not define' . I want to know what is wrong with the code. Or preferably a new one.

    Code
    Sub Button2_Click()
    Dim Wkb As Workbook
    Dim wbDest As Workbook, shtDest As Worksheet, source As Worksheet
    Dim path As String, ThisWB As String, Filename As String
    Dim CopyRng As Range, Dest As Range
    Dim currLastrow As Long, prevlastrow As Long        On Error GoTo err_exit    Application.EnableEvents = False    Application.ScreenUpdating = False
        currLastrow = 2 ' Row to start on in the sheets you are copying from        ThisWB = ActiveWorkbook.Name    Set shtDest = ActiveWorkbook.Sheets(1)        path = GetDirectory("Select a folder containing Excel files you want to merge")        Filename = Dir(path & "\*.xls", vbNormal)    If Len(Filename) = 0 Then Exit Sub        Do Until Filename = vbNullString            If Not Filename = ThisWB Then                    Set Wkb = Workbooks.Open(Filename:=path & "" & Filename)            Set source = Wkb.Sheets(1)            Set CopyRng = source.Range(source.Cells(currLastrow, 1), source.Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))                        Dest = shtDest.Range("B" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)            CopyRng.Copy Dest                        Wkb.Close False                        prevlastrow = currLastrow            currLastrow = shtDest.Cells(shdest.Rows.Count, "B").End(xlUp).Row            shdest.Cells(prevlastrow, "A").Resize(currLastrow - prevlastrow + 1).Value = Filename        End If                Filename = Dir()    Loop        shdest.Range("A1").Select        Application.EnableEvents = True    Application.ScreenUpdating = True        MsgBox "Done!"        Exit Sub
    
    GoTo err_exit:    Application.EnableEvents = True    Application.ScreenUpdating = True
    End Sub


    Thanks a lot.

  • Could you attach a copy of your destination file including any macros and at least one of the source files? It would be easier to see how your data is organized and to test possible solutions. Include a detailed explanation of what you want to do using a few examples from your data and referring to specific cells, rows, columns and sheets. De-sensitize the data if necessary.

    You can say "THANK YOU" for help received by clicking the :thumbup: icon in the bottom right corner of the helper's post.
    Practice makes perfect. I am very far from perfect so I'm still practising.

  • Place this macro in your destination workbook:

    You can say "THANK YOU" for help received by clicking the :thumbup: icon in the bottom right corner of the helper's post.
    Practice makes perfect. I am very far from perfect so I'm still practising.

  • Thanks alot. It worked perfectly.

    Sorry for this. I have a slight problem; I first used it with my sample folder that contain just 4 workbooks and it worked, but when I wanted to use it with the real folder containing 380 workbooks it failed to work. It did not respond at all. Please what could be responsible? Thanks

  • Try stepping through the macro one line of code at a time. Place the cursor anywhere in the macro and press the F8 key repeatedly. We’re any of the source workbooks opened? We’re any errors generated?

    You can say "THANK YOU" for help received by clicking the :thumbup: icon in the bottom right corner of the helper's post.
    Practice makes perfect. I am very far from perfect so I'm still practising.

  • Thanks

    When I tried that. Meaning, when I was pressing F8 repeating and the lines got to 'FolderName=. SelectedItem(1)&"\" ' it tried to open source folder. And when I picked it, it failed to performed any function. There was no error generated and it stopped there. I mean the F8 refused to go pass there. Thanks alot.

  • If the macro worked with the sample folder, I don't understand why it wouldn't work with the real folder. The number of source files should not effect how the macro works. Try copying the real files into your sample folder and give it another try.

    You can say "THANK YOU" for help received by clicking the :thumbup: icon in the bottom right corner of the helper's post.
    Practice makes perfect. I am very far from perfect so I'm still practising.

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!