Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String, arr, arr2, arr3, i As Long, n As Long, lr As Long, k As Long, col As New Collection
    Dim wb As Workbook
    'диалог запроса выбора папки с файлами
    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)
    'отключаем обновление экрана, чтобы наши действия не мелькали
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        'открываем книгу
        Set wb = Application.Workbooks.Open(sFolder & sFiles)
        'действия с файлом

        With Sheets(1)
        Columns(6).Delete
        Columns(6).Delete
        Columns(6).Delete
lr = .Cells(Rows.Count, 1).End(xlUp).Row
arr = .Range("A2:F" & lr)
For i = LBound(arr) To UBound(arr)
    On Error Resume Next
    col.Add arr(i, 1) & "//" & arr(i, 2) & "//" & arr(i, 3) & "//" & arr(i, 4) & "//" & "?????", arr(i, 1) & "//" & arr(i, 2) & "//" & arr(i, 3) & "//" & arr(i, 4) & "//" & "?????" & "//"
Next i
ReDim arr2(1 To col.Count, 1 To 6)
For i = 1 To col.Count
    arr3 = Split(col(i), "//")
    For n = LBound(arr3) To UBound(arr3)
        arr2(i, n + 1) = arr3(n)
    Next n
    arr2(i, 6) = Application.WorksheetFunction.SumIfs(.Columns(6), _
                 .Columns(1), arr3(0), _
                 .Columns(2), arr3(1), _
                 .Columns(3), arr3(2), _
                 .Columns(4), arr3(3))
Next i
End With
ActiveSheet.UsedRange.Offset(1).Clear
Sheets(1).Range("A2").Resize(UBound(arr2), 6) = arr2
Columns(5).Delete
Columns(3).Delete

        'Закрываем книгу с сохранением изменений
        wb.Close True 'если поставить False - книга будет закрыта без сохранения
        sFiles = Dir
    Loop
    'возвращаем ранее отключенное обновление экрана
    Application.ScreenUpdating = True
End Sub