Sub сумма()
'отключаем обновление экрана
Application.ScreenUpdating = False
'Отключаем автопересчет формул
'Application.Calculation = xlCalculationManual
'Отключаем отслеживание событий
Application.EnableEvents = False

Dim r As Range, cel As Range, wb As Workbook, awb As Workbook, s$, i&
Dim objFSO As FileDialog, objFolder As Object
Dim objFile, FS As Object
Set FS = CreateObject("Scripting.FileSystemObject")
Set objFSO = Application.FileDialog(msoFileDialogFolderPicker)

objFSO.AllowMultiSelect = False
objFSO.Show
Set objFolder = FS.getfolder(objFSO.SelectedItems(1))
s = "Обработано:"
Set r = Range("D17:E21,G17:H21,D23:E27,G23:H27,D29:E34,G29:H34,D35:E35,D37:E39,G37:H39,D42:E44,G42:H44") 'задание диапазона суммирования
Set awb = ThisWorkbook
r.ClearContents
'проход по всем файлам в папке "\2021"
For Each objFile In objFolder.Files
Set wb = Workbooks.Open(objFile)
i = i + 1
s = s & vbCr & i & "." & objFile
'проход по ячейкам
For Each cel In r
cel.Value = cel.Value + wb.Sheets("1_РЕЗ_ЧС").Range(cel.Address)
Next
wb.Close False
Next objFile
MsgBox s

'Возвращаем обновление экрана
Application.ScreenUpdating = True
'Возвращаем автопересчет формул
'Application.Calculation = xlCalculationAutomatic
'Включаем отслеживание событий
Application.EnableEvents = True

End Sub