title: I'm trying to merge all the excel spreadsheet into one Master spreadsheet
body: <p>I'm trying to write an Excel Macro that will traverse through all the folders in the directory, and merge multiple excel spreadsheet into one. All the excel spreadsheet have the same format. </p>
  
  <p>I'm able to traverse through all the folders in the directory but I keep getting errors when I try to merge the excel spreadsheet together. </p>
  
  <p>This is the error message I got: </p>
  
  <blockquote>
    <p>Run-time error '1004':</p>
    
    <p>Excel cannot insert the sheets into the destination workbook, because
    it contains fewer rows and columns than the source workbook. To move
    or copy the data to the destination workbook, you can select the data,
    and then use the Copy and Paste commands to insert it into the sheets
    of another workbook.</p>
  </blockquote>
  
  <p>This is what I have done so far: </p>
  
  <pre><code>Option Explicit
  Sub FileListingAllFolder()
  
  Dim pPath As String
  Dim FlNm As Variant
  Dim ListFNm As New Collection ' create a collection of filenames
  
  Dim OWb As Workbook
  Dim ShtCnt As Integer
  Dim Sht As Integer
  
  Dim MWb As Workbook
  Dim MWs As Worksheet
  Dim i As Integer
  
  ' Open folder selection
  With Application.FileDialog(msoFileDialogFolderPicker)
      .Title = "Select a Folder"
      .AllowMultiSelect = False
      If .Show &lt;&gt; -1 Then GoTo NextCode
      pPath = .SelectedItems(1)
  End With
  
  Application.WindowState = xlMinimized
  Application.ScreenUpdating = False
  
  ' Create master workbook with single sheets
  Set MWb = Workbooks.Add(1)
  MWb.Sheets(1).Name = "Result"
  Set MWs = MWb.Sheets("Result")
  
  ' Filling a collection of filenames (search Excel files including subdirectories)
  Call FlSrch(ListFNm, pPath, "*Issues.xls*", True)
  
  
  ' Print list to immediate debug window and as a message window
  For Each FlNm In ListFNm ' cycle for list(collection) processing
  
      'Start Processing here
      Set OWb = Workbooks.Open(FlNm)
      ShtCnt = ActiveWorkbook.Sheets.Count
      For Sht = 1 To ShtCnt
          Sheets(Sht).Copy After:=ThisWorkbook.Sheets(1)
      Next Sht
      OWb.Close False
  Next FlNm
  
  ' Print to immediate debug window and message if no file was found
  If ListFNm.Count = 0 Then
      Debug.Print "No file was found !"
      MsgBox "No file was found !"
      MWb.Close False
      End
  End If
  
  MWb.Activate
  MWs.Activate
  Cells.Select
  Selection.EntireColumn.AutoFit
  Range("A1").Select
  Application.ScreenUpdating = True
  Application.WindowState = xlMaximized
  
  End
  
  NextCode:
  MsgBox "You Click Cancel, and no folder selected!"
  
  End Sub
  
  Private Sub FlSrch(pFnd As Collection, pPath As String, pMask As String, pSbDir As Boolean)
  
  Dim flDir As String
  Dim CldItm As Variant
  Dim sCldItm As New Collection
  
  ' Add backslash at the end of path if not present
  pPath = Trim(pPath)
  
  If Right(pPath, 1) &lt;&gt; "\" Then pPath = pPath &amp; "\"
  
  ' Searching files accordant with mask
  flDir = Dir(pPath &amp; pMask)
      Do While flDir &lt;&gt; ""
          pFnd.Add pPath &amp; flDir 'add file name to list(collection)
          flDir = Dir ' next file
      Loop
  
  ' Procedure exiting if searching in subdirectories isn't enabled
  If Not pSbDir Then Exit Sub
  
  ' Searching for subdirectories in path
  flDir = Dir(pPath &amp; "*", vbDirectory)
      Do While flDir &lt;&gt; ""
      ' Do not search Scheduling folder
          If flDir &lt;&gt; "Scheduling" Then
              ' Add subdirectory to local list(collection) of subdirectories in path
              If flDir &lt;&gt; "." And flDir &lt;&gt; ".." Then If ((GetAttr(pPath &amp; flDir) And _
              vbDirectory) = 16) Then sCldItm.Add pPath &amp; flDir
          End If
          flDir = Dir 'next file
      Loop
  
  ' Subdirectories list(collection) processing
  For Each CldItm In sCldItm
      Call FlSrch(pFnd, CStr(CldItm), pMask, pSbDir) ' Recursive procedure call
  Next
  
  End Sub
  </code></pre>
  
  <p>I think this is the part that causes the problem. </p>
  
  <pre><code>For Each FlNm In ListFNm ' cycle for list(collection) processing
  
          'Start Processing here
          Set OWb = Workbooks.Open(FlNm)
          ShtCnt = ActiveWorkbook.Sheets.Count
          For Sht = 1 To ShtCnt
              Sheets(Sht).Copy After:=ThisWorkbook.Sheets(1)
          Next Sht
          OWb.Close False
      Next FlNm
  </code></pre>
  
  <p>I have been trying to mess with this code for two days now. I'm not too sure where I did it wrong.  :(</p>