Sub Sbor()
Dim Sht As Worksheet
Dim i As Long
Dim iLastRow As Long
Dim n As Integer
Dim j As Integer
Dim FoundCell As Range
Dim FAdr As String
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
  Range("B7:G" & iLastRow).ClearContents
      i = 7    'начальная строка в таблице на листе Итоги
    For Each Sht In Worksheets
      If Sht.Name <> "Итоги" Then        ' кроме листа "Итоги"
        With Sht
    Set FoundCell = .Columns(1).Find("поставщик:", , xlValues, xlWhole)
     If Not FoundCell Is Nothing Then
        FAdr = FoundCell.Address
        n = FoundCell.Row + 3    'начальная строка в таблице поставщика
      Do
        Cells(i, "B") = FoundCell.Offset(, 1)      'поставщик
        For j = n To .Cells(n - 1, "K").End(xlDown).Row
          Cells(i, "C") = .Cells(j, "K")             'дата
          Cells(i, "D") = .Cells(j, "J")             'накладная
          Cells(i, "F") = .Cells(j, "L")             'сумма
          Cells(i, "G") = .Cells(j, "M")             'налог
          i = i + 1
        Next
         Set FoundCell = .Columns(1).FindNext(FoundCell)
          n = FoundCell.Row + 3
      Loop While FoundCell.Address <> FAdr
     End If
        End With
      End If
    Next
End Sub