Application.ScreenUpdating = False
nm = ActiveWorkbook.Name
 
Range(Worksheets("Сводная").Cells(2, 1), Worksheets("Сводная").Cells(1048576, 4)).ClearContents
Range(Worksheets("Временная таблица").Cells(2, 1), Worksheets("Временная таблица").Cells(1048576, 4)).Clear


Dim avFiles
'по умолчанию к выбору доступны файлы Excel(xls,xlsx,xlsm,xlsb)
avFiles = Application.GetOpenFilename _
        ("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файлы", , True)
If VarType(avFiles) = vbBoolean Then
    'была нажата кнопка отмены - выход из процедуры
    Exit Sub
End If
    'avFiles - примет тип String
For Each x In avFiles
    Workbooks.Open x
    nm2 = ActiveWorkbook.Name
    n = Cells(Rows.Count, 17).End(xlUp).Row
    n2 = Workbooks(nm).Worksheets("Временная таблица").Cells(Rows.Count, 1).End(xlUp).Row + 1
    For i = 5 To n
        Workbooks(nm).Worksheets("Временная таблица").Cells(n2, 1) = Cells(i, 17)
        Workbooks(nm).Worksheets("Временная таблица").Cells(n2, 2) = Cells(i, 18)
        Workbooks(nm).Worksheets("Временная таблица").Cells(n2, 3) = Cells(i, 19)
        Workbooks(nm).Worksheets("Временная таблица").Cells(n2, 4) = Cells(i, 25)
        n2 = n2 + 1
    Next i
    Workbooks(nm2).Close
Next





'Подключаем библиотеку SQL
Dim CON As Object 'New ADODB.Connection
Dim RS As Object 'New ADODB.Recordset
Dim arrS

Set CON = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.Recordset")

CON.Provider = "Microsoft.ACE.OLEDB.12.0"
CON.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "; Extended Properties=""Excel 12.0 Xml;HDR=YES"""
CON.Open

'Заполняем шаблон
RS.Open "SELECT ИНН, КПП, Наименование, SUM(Сумма) FROM [Временная таблица$] GROUP BY ИНН, КПП, Наименование", CON
If RS.EOF Then
    RS.Close
Else
    Worksheets("Сводная").Range("A2").CopyFromRecordset RS
    RS.Close
End If

Application.ScreenUpdating = True
MsgBox "Готово"