Собрать данные из разных книг в одну

Option Compare Text
 
Sub Собрать_данные()
    ' Макрос собирает данные на активном листе активной книги из всех листов "Форма" xls файлов заданной директории,
    Dim ImenaListovSbora: ImenaListovSbora = Array("Форма", "Реестр")
    Const FirstRow_Cel& = 7          ' Номер строки начала построения
    Const FirstRow& = 7              ' Номер строки начала сбора данных (ниже шапки)
    Dim i&, LastRow&, LastRow_Cel&
    Dim ShCel As Worksheet, Sh As Worksheet, wb_Tek As Workbook
    Dim MyPath$, MyFileName$, MyFullName$
    Set ShCel = ActiveSheet
    LastRow_Cel = FirstRow_Cel
    With ShCel
        i = .UsedRange.Rows.Count + .UsedRange.Row - 1
        If i < FirstRow_Cel Then i = FirstRow_Cel
        .Rows(FirstRow_Cel & ":" & i).ClearContents
    End With
    MyPath = Trim$(ShCel.[C1])
    If Right$(MyPath, 1) <> "" Then MyPath = MyPath & ""
    MyFileName = Dir(MyPath & "*.xls*")
    Do Until MyFileName = ""
        MyFullName = MyPath & MyFileName
        Set wb_Tek = Workbooks.Open(Filename:=MyFullName, UpdateLinks:=0, ReadOnly:=True)
        For Each Sh In wb_Tek.Worksheets
            For i = 0 To UBound(ImenaListovSbora)
                If Sh.Name = ImenaListovSbora(i) Then
                    With Sh
                        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                        .Range(.Cells(FirstRow, 1), .Cells(LastRow, 8)).Copy
                        ShCel.Cells(LastRow_Cel, 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                        LastRow_Cel = LastRow_Cel + LastRow - FirstRow + 1
                    End With
                End If
            Next
        Next Sh
        wb_Tek.Close SaveChanges:=False
        MyFileName = Dir
    Loop
    With ShCel
        .Range(.Cells(LastRow_Cel - 1, 1), .Cells(LastRow_Cel - 1, 8)).Copy
        .Cells(LastRow_Cel, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
        .Cells(LastRow_Cel, 2).Select
    End With
End Sub

Application.Screenupdating = false

Application.DisplayAlerts = false

With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "Выбрать папку с отчётами"
        .Title = "Папка"
        If .Show <> -1 Then Exit Sub
        MyPath = .SelectedItems.Item(1) & "\"
    End With