Sub Копирование()
Dim fDialog As FileDialog, i As Object, wb As Workbook, Lastrow As Long
Dim objFolder As Object, FS As Object
Application.ScreenUpdating = False
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
Set FS = CreateObject("Scripting.FileSystemObject")
With fDialog
    .AllowMultiSelect = True
    .Show
    Set objFolder = FS.getfolder(.SelectedItems(1))
        For Each i In objFolder.Files
            Set wb = Application.Workbooks.Open(i)
            Lastrow = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
            Sheets("Исх").Range("B2:E10").Copy ThisWorkbook.Sheets(1).Cells(Lastrow + 1, 1)
            wb.Close False
        Next i
End With
Application.ScreenUpdating = True

End Sub

Sub Копирование_с_выбором_листа()
Dim fDialog As FileDialog, i As Object, wb As Workbook, Lastrow As Long
Dim objFolder As Object, FS As Object, shtName As String, button, sht As Worksheet
Application.ScreenUpdating = False
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
Set FS = CreateObject("Scripting.FileSystemObject")
With fDialog
    .AllowMultiSelect = True
    .Show
    Set objFolder = FS.getfolder(.SelectedItems(1))
    shtName = Application.InputBox("Введите имя листа, на который хотите скопировать информацию", Type:=2)
    If Not ifSheetExists(shtName) Then
        button = MsgBox("Листа с именем " & shtName & " не существует, создать?", vbYesNo)
        If button = vbYes Then
            Set sht = ThisWorkbook.Worksheets.Add
            sht.name = shtName
        Else
            MsgBox "Запустите макрос заново!!": Exit Sub
        End If
    End If
        
        For Each i In objFolder.Files
            Set wb = Application.Workbooks.Open(i)
            Lastrow = ThisWorkbook.Sheets(shtName).Cells(Rows.Count, 1).End(xlUp).Row ' здесь sheets("Лист1") - целевой лист куда вставлять значения, Лист1 - имя листа
            Sheets("Исх").Range("B2:E10").Copy
            ThisWorkbook.Sheets(shtName).Cells(Lastrow, 1).PasteSpecial xlValues ' вставить только значения, здесь sheets("Лист1") - целевой лист куда вставлять значения, Лист1 - имя листа
            wb.Close False
        Next i
End With
Application.ScreenUpdating = True
End Sub

Private Function ifSheetExists(name As String)
    Dim sht As Worksheet
    
    For Each sht In ThisWorkbook.Worksheets
        If sht.name = name Then
            ifSheetExists = True: Exit Function
        Else
            ifSheetExists = False
        End If
    Next sht
End Function