title: Merge excel files into a new excel file based on filename
body: <p>I have a folder containing about 500-600 excel files from a script I have made where the file names end up like this</p>
  <pre><code>101a12345.xlsx
  101a67899.xlsx
  102a12345.xlsx
  102a78999.xlsx
  </code></pre>
  <p>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.</p>
  <p>I have found a sample code here which i am trying to implement: <a href="https://stackoverflow.com/questions/34290553/how-to-merge-multiple-workbooks-into-one-based-on-workbooks-names">How to merge multiple workbooks into one based on workbooks names</a></p>
  <p>Taken from the link above:</p>
  <pre><code>Sub test(sourceFolder As String, destinationFolder As String)
      Const TO_DELETE_SHEET_NAME As String = &quot;toBeDeleted&quot;
      '------------------------------------------------------------------
      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(&quot;Scripting.Dictionary&quot;)
  
  
      filepath = Dir(sourceFolder)
  
      'Loop through each Excel file in folder
      Do While filepath &lt;&gt; &quot;&quot;
  
          If VBA.Right$(filepath, 5) = &quot;.xlsx&quot; Then
  
              Set wkbSource = Excel.Workbooks.Open(sourceFolder &amp; 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 &amp; varKey &amp; &quot;.xlsx&quot;)
  
  
      Next varKey
  
  
      'Restore Excel.Application settings.
      With Excel.Application
          .DisplayAlerts = settingDisplayAlerts
          .SheetsInNewWorkbook = settingSheetsNumber
      End With
  
  
  End Sub
  </code></pre>
  <p>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.</p>
  <p>is there a way to make this code work?</p>
  <p>Excel version is pro plus 2016.</p>