Sub SummaFromFiles()
Dim iFolder As String
Dim iFiles As String
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim iDate As Date
Dim FoundDate As Range
Dim FAdr As String
Dim TWB As Worksheet
Dim cellTop As Range
Dim cellDown As Range
Dim iCellTop As Long
Dim iCellDown As Long
Dim lastRowInJournal_E As Long
Dim insertRowInJournal_E As Long
Dim b As Boolean
Dim firstFoundRow
Dim lastFoundRow
Dim topAbroadTemplate 'Верхняя граница таблицы'
Dim downAbroadTemplate 'Нижняя граница таблицы'
Dim templateListName As String
Dim keyColumnToInsertInJournal As String
    keyColumnToInsertInJournal = "E"
    templateListName = "Касса"
    With Application.FileDialog(msoFileDialogFolderPicker)
      If .Show = False Then Exit Sub
      iFolder = .SelectedItems(1)      'выделяем папку с файлами для обработки
    End With
    iFolder = iFolder & IIf(Right(iFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
      iFiles = Dir(iFolder & "*.xls*")          'считываем очередной файл реестра
    'iLastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    iDate = Range("C1")
      Set TWB = ThisWorkbook.Worksheets("База операций")
  Do While iFiles <> ""
      Workbooks.Open iFolder & iFiles
      'действия с файлом реестра
    With ActiveWorkbook.Worksheets(templateListName)
    'Поиск таблицы'
     Cells.Find(What:="Сальдо на начало периода:", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
     'Определение координат таблицы'
     Set cellTop = Cells.Find(What:="Дата", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
   '!!!?Поставить проверку cellDown на cellTop. Если пусто -выдать предупреждение и прекратить работу?'
     Set cellDown = Cells.Find(What:="ИТОГО", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
   '!!!?Поставить проверку cellDown на Nothing. Если пусто -выдать предупреждение и прекратить работу?'
     Cells.Find(What:="Дата", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        
          iCellTop = cellTop.Row
          iCellDown = cellDown.Row
          cellTop.Activate
            
          Set FoundDate = .Columns(1).Find(iDate, , xlValues, xlWhole)
         
           b = False
           Dim ranges As String
           If Not FoundDate Is Nothing Then
             firstFoundRow = FoundDate.Row
             While (iCellDown) > ActiveCell.Row
               Set FoundDate = Cells.Find(What:=iDate, After:=ActiveCell, LookIn:=xlFormulas, _
                   LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                   MatchCase:=False, SearchFormat:=False)
               If b Then
                If FoundDate.Row <= firstFoundRow Then
                   GoTo copying
                End If
               End If
               lastFoundRow = FoundDate.Row
               FAdr = FoundDate.Address
               FoundDate.Activate
              
               'Копирование данных'
               'Find the last used column in a Row: row 1 in this example
               Dim LastCol As Range
               'With ActiveSheet
                         
               Set LastCol = Range(Cells(FoundDate.Row, cellTop.Column), Cells(FoundDate.Row, cellDown.Column + 7))
               If b Then
                ranges = ranges & "," & LastCol.Address
               Else
                ranges = LastCol.Address
               End If
               b = True
             Wend
           End If
copying:
           If Len(ranges) > 0 Then
              Worksheets(templateListName).Range(ranges).Copy
              'Вставка данных в шаблон'
                
               With TWB
                  lastRowInJournal_E = .Cells(.Rows.Count, keyColumnToInsertInJournal).End(xlUp).Row 'Ищем последнюю строку в столбце E шаблона'
                  insertRowInJournal_E = lastRowInJournal_E + 1
                  .Range(keyColumnToInsertInJournal & insertRowInJournal_E).PasteSpecial
                   
               End With
            End If
        'Закрываем книгу  без сохранения изменений
        .Parent.Close SaveChanges:=False
     End With
        iFiles = Dir    'следующий файл
    Loop
 Application.ScreenUpdating = True
End Sub