VBA batch combine multiple columns into 1

Can't get union or intersect to combine these column segments into 1 column.
Please help. Thanks.

Sub Merge_Data()
Dim SummarySheet As Worksheet
Dim FolderPath As String, FileName As String, SerialNum As String
'Dim FileName As String, SerialNum As String
Dim NCol As Long
Dim WorkBk As Workbook
Dim SourceRange As Range, DestRange As Range
Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range
Dim r6 As Range, r7 As Range, r8 As Range, r9 As Range
Dim Location As Integer, Length As Integer

' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

' Select folder path of excel files.
'With Application.FileDialog(msoFileDialogFolderPicker)
'.Show
'End With
'FolderPath = .SelectedItems(1)
'End With
FolderPath = "C:\whatever\"
'MsgBox FolderPath

' NRow keeps track of where to insert new rows in the destination workbook.
NCol = 1

' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xl*")
'MsgBox FileName

' Loop until Dir returns an empty string.
Do While FileName <> ""
If InStr(FileName, "_") = 0 Then
GoTo NextLoop
End If
' Open a workbook in the folder
Application.ScreenUpdating = False
Set WorkBk = Workbooks.Open(FolderPath & FileName)
Location = InStr(FileName, "-") + 1
Length = InStr(FileName, "_") - Location
SerialNum = Mid(FileName, Location, Length)
' Set the cell in column A to be the file name.
SummarySheet.Range("A1").Offset(1, NCol).Value = SerialNum

' Modify this range for your workbooks.
' It can span multiple rows.
Set r1 = WorkBk.Worksheets(1).Range("B8:E23")
Set r2 = WorkBk.Worksheets(1).Range("E8:E23")
Set r3 = WorkBk.Worksheets(1).Range("B37:B28")
Set r4 = WorkBk.Worksheets(1).Range("B32:B35")
Set r5 = WorkBk.Worksheets(1).Range("B34:B40")
Set r6 = WorkBk.Worksheets(1).Range("A42:A43")
Set r7 = WorkBk.Worksheets(1).Range("A47:A48")
Set r8 = WorkBk.Worksheets(1).Range("A51:A52")
Set r9 = WorkBk.Worksheets(1).Range("A56")
Set SourceRange = WorkBk.Worksheets(1).Range("E8:E23")

' Set the destination range be the same size as the source range.
Set DestRange = SummarySheet.Range("A1").Offset(2, 1)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, NCol)

' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value

' Increase NRow so that we know where to copy data next.
NCol = DestRange.Columns.Count + 1

' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False

' Use Dir to get the next file name.
NextLoop:
FileName = Dir()

Loop

' Call AutoFit on the destination sheet so that all
' data is readable.
Application.ScreenUpdating = True
SummarySheet.Columns.AutoFit
End Sub