Sub Кнопка1_Щелчок()

Dim r As Range, ccell As Range, wb As Workbook, svodwb As Workbook, awb As Workbook, s$, sExt$, i&
Dim wsSh As Worksheet, wsDataSheet As Worksheet, lastrow&
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")

'MsgBox "=" & awb.FullName
On Error Resume Next
Set objFolder = objFSO.GetFolder([B1])
If Err Then
  MsgBox "Ошибочное имя каталога " & [B1]
  Exit Sub
End If

Set svodwb = Workbooks.Open([B2])
If Err Then
  MsgBox "Невозможно открыть сводный файл " & [B2]
  Exit Sub
End If

Set awb = ThisWorkbook
s = "Обработано:"
'Set r = Range("E9:E29") 'задание диапазона суммирования
'r.ClearContents

' Очистим сводный файлы
For Each wsSh In svodwb.Worksheets
              
  ' последнюю строчку ищем по столбцу A номер 1
  lastrow = wsSh.Cells(Rows.Count, 1).End(xlUp).Row
  Set r = wsSh.Range("E9:E" & lastrow) 'задание диапазона суммирования
  r.ClearContents
              
Next wsSh
                

'проход по всем файлам в папке "\files"
For Each objFile In objFolder.Files
    sExt = LCase(objFSO.GetExtensionName(objFile.Name))
    If (sExt = "xls") Or (sExt = "xlsx") Then

        If Not ((objFile.Path = awb.FullName) Or (objFile.Path = svodwb.FullName) Or (Left(objFile.Name, 2) = "~$")) Then
            Set wb = Workbooks.Open(objFile)
            If Err Then
                MsgBox ("Ошибка при открытии файла " & objFile)
                Err.Clear
            Else
                i = i + 1
                s = s & vbCr & i & "." & objFile
                
                For Each wsSh In svodwb.Worksheets
                    
                  ' последнюю строчку ищем по столбцу A номер 1
                  lastrow = wsSh.Cells(Rows.Count, 1).End(xlUp).Row
                  Set r = wsSh.Range("E9:E" & lastrow) 'задание диапазона суммирования
                  For Each ccell In r
                      ccell.Value = ccell.Value + wb.Sheets(wsSh.Name).Range(ccell.Address)
                  Next ccell
                    
                Next wsSh
                
                
                'проход по ячейкам
                '    For Each cel In r
                '   cel.Value = cel.Value + wb.Sheets("п5").Range(cel.Address)
                '   Next
                wb.Close False
            End If
        End If
    End If
Next
MsgBox s

End Sub

'Выбираем диапазон выборки с книг
Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _
"1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _
vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8)
'для указания диапазона без диалогового окна:
'Set iBeginRange = Range("A1:A10") 'диапазон указывается нужный
'Если диапазон не выбран - завершаем процедуру
If iBeginRange Is Nothing Then Exit Sub