Multiple range selection in VBA - Consolidating multiple workbooks into one master workbook

Question

I am trying to consolidate a few workbooks in a same folder into a master workbook for charting purposes. I'm using Ron De Bruin's code to accomplish this. Everything works out pretty well so far. I only require one more feature to make it perfect for my application.

In the code, the source range selected is in one whole massive range (B12:H316) and I'll have to use pivot table to filter it. In actual, I only require B12:H12, B20:H20, B316:H316. I have tried many tweaks like Set SourceRange = Union(.Range("B12:H12"), .Range("B20:H20"), .Range("B316:H316")) as well as Set SourceRange = .Range("B12:H12","B20:H20","B316:H316") but nothing works so far.

Is there anyway for me to tweak the line of code so that I'm able to only select B12:H12, B20:H20, and B316:H316 as the source range to be copied from each workbook available in the particular folder?

I understand that Ron De Bruin has an add-in feature to cater for multiple range. However I'm not able to use it due to some company policy.

Below is my the code I'm having right now :

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

' Change this to the path\folder location of your files.
MyPath = "C:\Users\Captain\Desktop\Target Test"

' Add a slash at the end of the path if needed.
If Right(MyPath, 1) <> "\" Then
    MyPath = MyPath & "\"
End If

' If there are no Excel files in the folder, exit.
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
    MsgBox "No files found"
    Exit Sub
End If

' Fill the myFiles array with the list of Excel files
' in the search folder.
FNum = 0
Do While FilesInPath <> ""
    FNum = FNum + 1
    ReDim Preserve MyFiles(1 To FNum)
    MyFiles(FNum) = FilesInPath
    FilesInPath = Dir()
Loop

' Set various application properties.
With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
End With

' Use existing sheet
Set BaseWks = Workbooks("SPC.xlsm").Worksheets("RawData")
rnum = BaseWks.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1


' Loop through all files in the myFiles array.
If FNum > 0 Then
    For FNum = LBound(MyFiles) To UBound(MyFiles)
        Set mybook = Nothing
        On Error Resume Next
        Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
        On Error GoTo 0

        If Not mybook Is Nothing Then
            On Error Resume Next

            ' Change this range to fit your own needs.

            With mybook.Worksheets(1)

            Set SourceRange = .Range("B12:H316")

                End With

            If Err.Number > 0 Then
                Err.Clear
                Set SourceRange = Nothing
            Else
                ' If source range uses all columns then
                ' skip this file.
                If SourceRange.Columns.Count >= BaseWks.Columns.Count Then
                    Set SourceRange = Nothing
                End If
            End If
            On Error GoTo 0

            If Not SourceRange Is Nothing Then

                SourceRcount = SourceRange.Rows.Count

                If rnum + SourceRcount >= 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.
                    With SourceRange
                        BaseWks.Cells(rnum, "A"). _
                                Resize(.Rows.Count).Value = MyFiles(FNum)
                    End With

                    ' Set the destination range.
                    Set DestRange = BaseWks.Range("B" & rnum)

                    ' Copy the values from the source range
                    ' to the destination range.
                    With SourceRange
                        Set DestRange = DestRange. _
                                        Resize(.Rows.Count, .Columns.Count)
                    End With
                    DestRange.Value = SourceRange.Value

                    rnum = rnum + SourceRcount
                End If
            End If
            mybook.Close savechanges:=False
        End If

    Next FNum
    BaseWks.Columns.AutoFit
End If

    ExitTheSub:
' Restore the application properties.
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = CalcMode
End With
End Sub

I appreciate any form of help given. Thanks alot for your time.

Answer 1

Using Set SourceRange = Union(.Range("B12:H12"), .Range("B20:H20"), .Range("B316:H316")) will work, but with some odd side effects. If the Union created a "continuous" range (eg "B12:H15"), then all would work OK. Because it has Row gaps, you don't get the results normally expected.

SourceRange.Rows.Count evaluates to 1, so the value for SourceRCount will be incorrect.

1) Replace this snippet ...

SourceRcount = SourceRange.Rows.Count

... with this ...

Dim aRow as Range
SourceRCount = 0
For Each aRow In SourceRange.Rows
    SourceRCount = SourceRCount + 1
Next aRow

2) Also, the following snippet will need correction ...

    With SourceRange
        BaseWks.Cells(rnum, "A"). _ 
            Resize(.Rows.Count).Value = MyFiles(FNum)
    End With

... probably to this ...

    BaseWks.Cells(rnum, "A").Resize(SourceRCount).Value = MyFiles(FNum)

3) This snippet ...

    With SourceRange
        Set DestRange = DestRange. _
                        Resize(.Rows.Count, .Columns.Count)
    End With

... should become (Columns.Count works correctly) ...

    Set DestRange = DestRange.Resize(SourceRCount, SourceRange.Columns.Count)

4) Finally, this assignment will not work as expected ...

    DestRange.Value = SourceRange.Value

... and should be changed to ...

Dim RCount as long
RCount = 0
For Each aRow In SourceRange.Rows
    RCount = RCount + 1
    DestRange.Rows(RCount).Value = aRow.Value
Next aRow