Как объединить несколько файлов Excel в одну таблицу (код макроса)

По многочисленным просьбам выкладываю ниже текст макроса из видео https://rutube.ru/video/5833afc53fb0b88a602a420a0630a372/

Sub Обработчик()
'
' Обработчик Макрос
'

'
Dim sFolder As String, sFiles As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
sFolder = .SelectedItems(1)
End With
sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
sFiles = Dir(sFolder & "*.xls*")
Application.ScreenUpdating = False
Do While sFiles <> ""
Workbooks.Open sFolder & sFiles

Rows("1:3").Select
Selection.Delete Shift:=xlUp
Rows(Cells(Rows.Count, "A").End(xlUp).Row).Select
Selection.Delete Shift:=xlUp

ActiveWorkbook.Save
ActiveWorkbook.Close True
sFiles = Dir
Loop
Dim FilesToOpen
Dim x As Integer

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="All files (*.*), *.*", _
MultiSelect:=True, Title:="Files to Merge")

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "Не выбрано ни одного файла!"
Exit Sub
End If


x = 1
While x <= UBound(FilesToOpen)
Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
importWB.Close savechanges:=False
x = x + 1
Wend
Application.DisplayAlerts = False
Sheets("Лист1").Delete
Application.DisplayAlerts = True
Dim ws As Worksheet
Set wbCurrent = ActiveWorkbook
Workbooks.Add
Set wbReport = ActiveWorkbook

wbCurrent.Worksheets(1).Range("A1:E1").Copy Destination:=wbReport.Worksheets(1).Range("A1")


For Each ws In wbCurrent.Worksheets
n = wbReport.Worksheets(1).Range("A1").CurrentRegion.Rows.Count
Set rngData = ws.Range("A2", ws.Range("A2").SpecialCells(xlCellTypeLastCell))
rngData.Copy Destination:=wbReport.Worksheets(1).Cells(n + 1, 1)

Next ws




Application.ScreenUpdating = True

End Sub