title: Modifying Ron de Bruin Merge Workbook Code for Multiple Ranges?
body: <p>I was doing some research for a project and came across <a href="https://i.stack.imgur.com/w0mrj.png" rel="nofollow noreferrer">some code</a> from Ron de Bruin for merging multiple workbooks. It works quite well - you put the excel files you want in a folder on your desktop, run the code, and it combines each workbook into a single excel summary - basically I'm using it for data collection purposes.</p>
  
  <p>The problem I'm having is that I can't seem to specify more than one range without messing up the summary page.</p>
  
  <p>For example, these are the two workbooks/data sets I'm looking to combine:</p>
  
  <p><a href="https://i.stack.imgur.com/w0mrj.png" rel="nofollow noreferrer">Workbook 1</a></p>
  
  <p><a href="https://i.stack.imgur.com/fozjH.png" rel="nofollow noreferrer">Workbook 2</a></p>
  
  <p>The final summary result should look like this:</p>
  
  <p><a href="https://i.stack.imgur.com/yC45M.png" rel="nofollow noreferrer">Should Look Like This</a></p>
  
  <p>However, the summary currently looks like this:</p>
  
  <p><a href="https://i.stack.imgur.com/Wr285.png" rel="nofollow noreferrer">Results Currently Look Like This</a></p>
  
  <p>The code and attachments for review are below:</p>
  
  <p><a href="https://drive.google.com/drive/folders/0Bwx3ybze4rlWM3FZZHREWEh2T00?usp=sharing" rel="nofollow noreferrer">https://drive.google.com/drive/folders/0Bwx3ybze4rlWM3FZZHREWEh2T00?usp=sharing</a></p>
  
  <p>The problem comes when I specify multiple ranges with this section:</p>
  
  <pre><code>Set sourceRange = .Range("A1:G2", "A7:G8")
  </code></pre>
  
  <p>Note also that if you want to test this on your computer, you will need to modify the section you've put the folder with the files to be uploaded:</p>
  
  <pre><code>'Fill in the path\folder where the files are
  MyPath = "D:\Transfer\Transfer Test\"
  </code></pre>
  
  <hr>
  
  <pre><code>Sub MergeAllWorkbooks()
      Dim MyPath As String, FilesInPath As String
      Dim MyFiles() As String
      Dim SourceRcount As Long, FNum As Long
      Dim mybook As Workbook, BaseWks As Worksheet
      Dim sourceRange As Range, destrange As Range
      Dim rnum As Long, CalcMode As Long
  
      'Fill in the path\folder where the files are
      MyPath = "D:\Budget Transfer\Transfer Test\"
  
      'Add a slash at the end if the user forget it
      If Right(MyPath, 1) &lt;&gt; "\" Then
          MyPath = MyPath &amp; "\"
      End If
  
      'If there are no Excel files in the folder exit the sub
      FilesInPath = Dir(MyPath &amp; "*.xl*")
      If FilesInPath = "" Then
          MsgBox "No files found"
          Exit Sub
      End If
  
      'Fill the array(myFiles)with the list of Excel files in the folder
      FNum = 0
      Do While FilesInPath &lt;&gt; ""
          FNum = FNum + 1
          ReDim Preserve MyFiles(1 To FNum)
          MyFiles(FNum) = FilesInPath
          FilesInPath = Dir()
      Loop
  
      'Change ScreenUpdating, Calculation and EnableEvents
      With Application
          CalcMode = .Calculation
          .Calculation = xlCalculationManual
          .ScreenUpdating = False
          .EnableEvents = False
      End With
  
      'Add a new workbook with one sheet
      Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
      'First Row of Target Spreadsheet is Blank
      rnum = 1
  
      'Loop through all files in the array(myFiles)
      If FNum &gt; 0 Then
          ' This section modified from original Ron de Bruin code to include individual items outside range per https://stackoverflow.com/questions/46718110/create-separate-row-for-each-item-when-merging-multiple-workbooks
          For FNum = LBound(MyFiles) To UBound(MyFiles)
              Set mybook = Nothing
              On Error Resume Next
              Set mybook = Workbooks.Open(MyPath &amp; MyFiles(FNum))
              On Error GoTo 0
  
              If Not mybook Is Nothing Then
                  With mybook.Worksheets(1)
                      Set sourceRange = .Range("A1:G2", "A7:G8")
  
                      SourceRcount = sourceRange.Rows.Count
  
                      If rnum + SourceRcount &gt;= BaseWks.Rows.Count Then
                          MsgBox "There are not enough rows in the target worksheet."
                          BaseWks.Columns.AutoFit
                          mybook.Close savechanges:=False
                          GoTo ExitTheSub
                      Else
  
                          ' Copy the file name in column A. "+1" indicates that the data on the destination sheet is shifted down one row
                          BaseWks.Cells(rnum + 1, "A").Resize(SourceRcount).Value = MyFiles(FNum)
                          ' Copy information from an indivudual cell outside of a range such as date/time started, start/final temp, and Batch ID
                          BaseWks.Cells(rnum + 1, "B").Resize(SourceRcount).Value = .Range("K1").Value
                          BaseWks.Cells(rnum + 1, "C").Resize(SourceRcount).Value = .Range("K2").Value
                          BaseWks.Cells(rnum + 1, "D").Resize(SourceRcount).Value = .Range("K3").Value
                          BaseWks.Cells(rnum + 1, "E").Resize(SourceRcount).Value = .Range("K4").Value
                          BaseWks.Cells(rnum + 1, "F").Resize(SourceRcount).Value = .Range("K5").Value
                          'Copy main data
                          BaseWks.Cells(rnum + 1, "G").Resize(SourceRcount, sourceRange.Columns.Count).Value = sourceRange.Value
  
                          sourceRange.Copy
  
                          'Set the destrange (this code is part of the code that copies and pastes formats)this is part of the original Ron de Bruin code and not part of YowE3k revision on Stackoverflow
                          Set destrange = BaseWks.Range("G" &amp; rnum + 1)
  
                          'this code copies and pastes formats per https://www.rondebruin.nl/win/s3/win008.htm
                          With destrange
                              .PasteSpecial xlPasteValues
                              .PasteSpecial xlPasteFormats
                              Application.CutCopyMode = False
                          End With
  
                          rnum = rnum + SourceRcount
                      End If
                  End With
              End If
              mybook.Close savechanges:=False
  
          Next FNum
          ' This line above finishes the modified code to include individual items outside range per https://stackoverflow.com/questions/46718110/create-separate-row-for-each-item-when-merging-multiple-workbooks
          BaseWks.Columns.AutoFit
      End If
  
  ExitTheSub:
      'Restore ScreenUpdating, Calculation and EnableEvents
      With Application
          .ScreenUpdating = True
          .EnableEvents = True
          .Calculation = CalcMode
      End With
  End Sub
  </code></pre>
  
  <p>The original code caused some of the range to not display. After modifying the code using some of YowE3K's code below, the ranges now display on the summary, but I am having an issue where the range I've specified is now pulling in blank rows between the two ranges.</p>
  
  <p>I've read that specifying a range like .Range("A1:G2", "A7:G8") is the equivalent of specifying a range of A1:G8, and that two separate ranges need to be specified as "A1:G2 , A7:G8", but this does not work, so I am at a loss. How can the code be fixed to remove the blank rows between these two ranges? I am not very familiar with macros, so I am not too sure where the specific issue is occurring.</p>