Merge excel files into a new excel file based on filename

Question

I have a folder containing about 500-600 excel files from a script I have made where the file names end up like this

101a12345.xlsx
101a67899.xlsx
102a12345.xlsx
102a78999.xlsx

The file names follow that patern, 101a, 102a etc. What i want to do is merge those based on that paternt into 1 excel file. Therefore, the 101a12345.xlsx and 101a67899.xlsx should merge into an 101aMaster.xlsx. All excel files are single sheet.

I have found a sample code here which i am trying to implement: How to merge multiple workbooks into one based on workbooks names

Taken from the link above:

Sub test(sourceFolder As String, destinationFolder As String)
    Const TO_DELETE_SHEET_NAME As String = "toBeDeleted"
    '------------------------------------------------------------------
    Dim settingSheetsNumber As Integer
    Dim settingDisplayAlerts As Boolean
    Dim dict As Object
    Dim wkbSource As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim filepath As String
    Dim code As String * 4
    Dim wkbDestination As Excel.Workbook
    Dim varKey As Variant
    '------------------------------------------------------------------


    'Change [SheetsInNewWorkbook] setting of Excel.Application object to
    'create new workbooks with a single sheet only.
    With Excel.Application
        settingDisplayAlerts = .DisplayAlerts
        settingSheetsNumber = .SheetsInNewWorkbook
        .SheetsInNewWorkbook = 1
        .DisplayAlerts = False
    End With


    Set dict = VBA.CreateObject("Scripting.Dictionary")


    filepath = Dir(sourceFolder)

    'Loop through each Excel file in folder
    Do While filepath <> ""

        If VBA.Right$(filepath, 5) = ".xlsx" Then

            Set wkbSource = Excel.Workbooks.Open(sourceFolder & filepath)
            Set wks = wkbSource.Worksheets(1)
            code = VBA.Left$(wkbSource.Name, 4)


            'If this code doesn't exist in the dictionary yet, add it.
            If Not dict.exists(code) Then
                Set wkbDestination = Excel.Workbooks.Add
                wkbDestination.Worksheets(1).Name = TO_DELETE_SHEET_NAME
                Call dict.Add(code, wkbDestination)
            Else
                Set wkbDestination = dict.Item(code)
            End If

            Call wks.Copy(Before:=wkbDestination.Worksheets(1))
            wkbDestination.Worksheets(1).Name = VBA.Mid$(filepath, 6)

            Call wkbSource.Close(False)

        End If

        filepath = Dir

    Loop


    'Save newly created files.
    For Each varKey In dict.keys
        Set wkbDestination = dict.Item(varKey)

        'Remove empty sheet.
        Set wks = Nothing
        On Error Resume Next
        Set wks = wkbDestination.Worksheets(TO_DELETE_SHEET_NAME)
        On Error GoTo 0

        If Not wks Is Nothing Then wks.Delete


        Call wkbDestination.SaveAs(Filename:=destinationFolder & varKey & ".xlsx")


    Next varKey


    'Restore Excel.Application settings.
    With Excel.Application
        .DisplayAlerts = settingDisplayAlerts
        .SheetsInNewWorkbook = settingSheetsNumber
    End With


End Sub

However, this code opens all workbooks and at about 60-70 open excel files i receive an error: Run-time Error '1004' - Method 'Open' of object 'Workbooks' failed.

is there a way to make this code work?

Excel version is pro plus 2016.

Answer 1

How do I merge Excel files that have the same name?
Open the Excel file in which you want to combine sheets from different workbooks and do the following steps:
To access the Macro dialogue, press Alt + F8.
Select MergeExcelFiles from the Macro name drop-down menu and hit Run.
The regular explorer window will open, and you can choose one or more workbooks to merge before clicking Open.