Сбор данных, каким образом сделать это быстро

'так в диалоговом окне выбираю нужные мне файлы для объединения
Private Sub CommandButton1_Click()
 
 arrPlaFiles = Application.GetOpenFilename("* (*.*),*.*", , s, , True)
        If IsArray(arrPlaFiles) Then
                TextBox1.Text = ""
                For i = 1 To UBound(arrPlaFiles)
                    TextBox1.Text = TextBox1.Text & arrPlaFiles(i) & "; " & vbCrLf
                Next i
                Exit Sub
            Else
                If MsgBox("Прервать расчет ?", vbOKCancel) = vbOK Then Unload UserForm1
        End If
 
End Sub
 
 
 
Private Sub CommandButton2_Click()
 
    Dim preres, ws As Worksheet
    Dim staff() As Boolean
    Dim surname As String
 
'а тут уже в цикле просматриваю выбранные мной книги
 
    If (TextBox1.Text = "") Then
        MsgBox ("Вначале выберите файлы!")
        Exit Sub
    End If
 
 
    ReDim staff(UBound(arrPlaFiles))
    For lLoop = 1 To UBound(arrPlaFiles)
        staff(lLoop) = False
    Next lLoop
    
        For lLoop = 1 To UBound(arrPlaFiles)
         Workbooks.Open arrPlaFiles(lLoop), False
 
'а сюда как раз кусок который бы копировал из выбранных книг в общую все данные
 
Workbooks(arrPlaFiles(lLoop)).Close
  Next lLoop

Private Sub CommandButton2_Click()
    Const FRow& = 2  ' Номер строки начала сбора данных (ниже шапки)
'    Dim preres, ws As Worksheet            'Лишнее
'    Dim staff() As Boolean                 'Лишнее
'    Dim surname As String                   'Лишнее
    Dim lLoop&, FCol&, LCol&, LRow&, LRow_Cel&
    Dim wb_Tek As Workbook
    Dim Sh_Cel As Worksheet, Sh_Tek As Worksheet
    Set Sh_Cel = ThisWorkbook.ActiveSheet
    If (TextBox1.Text = "") Then
        MsgBox ("Вначале выберите файлы!")
        Exit Sub
    End If
'    ReDim staff(UBound(arrPlaFiles))       'Лишнее
'    For lLoop = 1 To UBound(arrPlaFiles)   'Лишнее
'        staff(lLoop) = False               'Лишнее
'    Next lLoop                             'Лишнее
    For lLoop = 1 To UBound(arrPlaFiles)
        Set wb_Tek = GetObject(arrPlaFiles(lLoop))
        'либо
        'Set wb_Tek = Workbooks.Open(arrPlaFiles(lLoop), False)
        With Sh_Cel
            FCol = .UsedRange.Cells(1, 1).Column
            LCol = .UsedRange.Columns.Count + FCol - 1
            LRow_Cel = .UsedRange.Rows.Count + .UsedRange.Cells(1, 1).row
        End With
        With wb_Tek.Worksheets(1)
        ' Либо
        'With wb_Tek.Worksheets("Имя_нужного_листа_сбора")
            LRow = .UsedRange.Rows.Count + .UsedRange.Cells(1, 1).row - 1
            If LRow >= FRow Then
                .Range(.Cells(FRow, FCol), .Cells(LRow, LCol)).Copy Sh_Cel.Cells(LRow_Cel, 1)
            End If
        End With
       Workbooks(arrPlaFiles(lLoop)).Close False
     Next lLoop
End Sub

Dim arrPlaFiles

LCol = .UsedRange.Columns.Count + FCol - 1

  With wb_Tek.Worksheets(1)
            LCol = .UsedRange.Columns.Count + FCol - 1 
            LRow = .UsedRange.Rows.Count + .UsedRange.Cells(1, 1).Row - 1
            If LRow >= FRow Then
                .Range(.Cells(FRow, FCol), .Cells(LRow, LCol)).Copy Sh_Cel.Cells(LRow_Cel, 1)
            End If
        End With

 Workbooks(arrPlaFiles(lLoop)).Close False

wb_Tek.close 0