Option Explicit

Sub Main()
    Dim aFiles As Variant
    aFiles = ShowFileDialog()
    
    If Not IsEmpty(aFiles) Then
        Application.EnableEvents = False
        Dim Application_Calculation As Long
        Application_Calculation = Application.Calculation
        Application.Calculation = xlCalculationManual
        Application.ScreenUpdating = False
    
        Dim wbOut As Workbook
        Set wbOut = Workbooks.Add(1)
        Dim rOut As Range
        Set rOut = wbOut.Sheets(1).Cells(1, 1)
        
        Dim vFile As Variant
        For Each vFile In aFiles
            JobvFile vFile, rOut
        Next
        
        wbOut.Saved = True
        Application.EnableEvents = False
        Application.Calculation = Application_Calculation
        Application.ScreenUpdating = True
    
    End If
End Sub

Sub JobvFile(ByVal sFile As String, rOut As Range)
    Dim y As Long
    Dim arr As Variant
    
    Dim wb As Workbook
    Set wb = Workbooks.Open(sFile, False, True)
    
    With wb.Sheets(1)
        y = .Cells(.Rows.Count, 3).End(xlUp).Row
        If y > 4 Then
            arr = .Range(.Cells(4, 1), .Cells(y, "G"))
        End If
    End With
    
    Dim sName As String
    sName = wb.Name
    sName = Left(sName, InStrRev(sName, ".") - 1)
    wb.Close False
    
    If Not IsEmpty(arr) Then
        Dim s As String
        For y = 1 To UBound(arr, 1)
            If arr(y, 2) <> "" Then s = arr(y, 2)
            arr(y, 6) = s
            arr(y, 7) = sName
        Next
        rOut.Resize(UBound(arr, 1), UBound(arr, 2)) = arr
        Set rOut = rOut.Offset(UBound(arr, 1))
    End If
End Sub

Function ShowFileDialog() As Variant
'www.excel-vba.ru
    Dim arr As Variant
    Dim oFD As FileDialog
    Dim lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    With oFD 'используем короткое обращение к объекту
    'так же можно без oFD
    'With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "Выбрать файлы отчетов" 'заголовок окна диалога
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .Filters.Add "Excel files", "*.xls*;*.xla*", 1 'устанавливаем возможность выбора только файлов Excel
        '.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
        .FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
        .InitialFileName = ThisWorkbook.Path 'назначаем папку отображения и имя файла по умолчанию
        .InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
        If oFD.Show = 0 Then Exit Function 'показывает диалог
        ReDim arr(1 To .SelectedItems.Count)
        'цикл по коллекции выбранных в диалоге файлов
        For lf = 1 To .SelectedItems.Count
            arr(lf) = .SelectedItems(lf)
        Next
    End With
    ShowFileDialog = arr
End Function