Sub Otchet()
Dim i As Long
Dim iLastRow As Long
Dim FirstRow As Integer
Dim iLastCol As Integer
Dim Otchet As Worksheet
Dim FoundCell As Range
Dim n As Integer
Dim iStroka As Integer
Dim FAdr As String
Dim SummaI As Double
Dim SummaJ As Double
  iLastCol = Cells(3, Columns.Count).End(xlToLeft).Column
  iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
  Range(Cells(3, iLastCol + 3), Cells(iLastRow + 1, iLastCol + 4)).ClearContents
  Range(Cells(3, iLastCol + 3), Cells(iLastRow + 1, iLastCol + 4)).Interior.ColorIndex = xlNone
  Range("B3:B" & iLastRow).AdvancedFilter xlFilterCopy, CopyToRange:=Cells(4, iLastCol + 3), Unique:=True
  Range("C3:C" & iLastRow).AdvancedFilter xlFilterCopy, CopyToRange:=Cells(4, iLastCol + 4), Unique:=True
   Set Otchet = ThisWorkbook.Worksheets("Отчет")
  With Otchet
    Set FoundCell = .Columns("A:C").Find("ИТОГО по Разделу 1:", , xlValues, xlWhole)
     If Not FoundCell Is Nothing Then
       If FoundCell.Row > 13 Then
         .Rows("13:" & FoundCell.Row - 1).Delete
       End If
       iStroka = 13
       iLastRow = Cells(Rows.Count, iLastCol + 4).End(xlUp).Row
       For i = 5 To iLastRow
        Set FoundCell = Columns("C").Find(Cells(i, iLastCol + 4), , xlValues, xlWhole)
        If Not FoundCell Is Nothing Then
         FAdr = FoundCell.Address
         .Rows(iStroka).Insert
         .Range("A" & iStroka & ":O" & iStroka).MergeCells = True
         .Range("A" & iStroka) = "Вид продукта: " & Cells(i, iLastCol + 4)
           iStroka = iStroka + 1
           n = 1
           FirstRow = iStroka
         Do
           .Rows(iStroka).Insert
           .Cells(iStroka, "A") = n
           Range("B" & FoundCell.Row & ":K" & FoundCell.Row).Copy .Cells(iStroka, "B")
           .Range("A" & iStroka & ":O" & iStroka).Borders.Weight = xlThin
          Set FoundCell = Columns("C").FindNext(FoundCell)
          n = n + 1
          iStroka = iStroka + 1
         Loop While FoundCell.Address <> FAdr
        End If
         .Rows(iStroka).Insert
         .Range("A" & iStroka & ":O" & iStroka).Borders.Weight = xlThin
         .Range("A" & iStroka & ":C" & iStroka).MergeCells = True
         .Range("A" & iStroka) = "ИТОГО по виду продукта:"
         .Range("I" & iStroka) = WorksheetFunction.Sum(.Range(.Cells(FirstRow, "I"), .Cells(iStroka - 1, "I")))
         .Range("J" & iStroka) = WorksheetFunction.Sum(.Range(.Cells(FirstRow, "J"), .Cells(iStroka - 1, "J")))
            SummaI = SummaI + .Range("I" & iStroka)
            SummaJ = SummaJ + .Range("J" & iStroka)
            iStroka = iStroka + 1
       Next
         .Range("I" & iStroka) = SummaI
         .Range("J" & iStroka) = SummaJ
     Else
     End If
  End With
    Columns(Split(Cells(3, iLastCol + 3).Address, "$")(1) & ":" & Split(Cells(3, iLastCol + 4).Address, "$")(1)).Delete
End Sub