Sub RaznestiDannye()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim iLR_old As Long
Dim n As Long
Dim iLastCol As Integer
Dim Criterij As String
Dim iName As String
Dim Sht As Worksheet
Dim iSht As Worksheet
Dim j As Integer
Application.ScreenUpdating = False
  Set Sht = ThisWorkbook.Worksheets("Общ")
  iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
   Rows(iLastRow + 1).Delete  'удаляем строку с суммами в F:I
     'количество значений групп (Шпон, Файн и т.д.)
      n = Cells(1, "J").End(xlDown).Row
    For i = 1 To n          'цикл по значениям
        Criterij = Sht.Cells(i, "J")   'очередная группа
        iName = Criterij    'имя очередного листа
     'ставим автофильтр по столбцу J
       Sht.Range("B14:J" & iLastRow).AutoFilter 9, Criterij
         Set iSht = Worksheets(iName)
        With iSht                      'очередной лист соотв.группы
          iLastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column  'посл.столбец по строке 3
          iLR = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
            If iLR < 4 Then iLR = 4
          .Range("B4:I" & iLR).Clear   'очищаем данные на соотв.листе
          'копируем видимые строки без шапки в соответств. лист
         Sht.AutoFilter.Range.Offset(1).Columns("A:H").SpecialCells(xlCellTypeVisible).Copy
          .Range("B4").PasteSpecial xlPasteValues
          Application.CutCopyMode = False
          .Activate
          .Range("B4").Select
          iLR = Cells(Rows.Count, "B").End(xlUp).Row       'посл.строка в столбце В
            If iLR < 4 Then iLR = 4                        'не учитывая строк Сумма и Сальдо
          iLR_old = Cells(Rows.Count, "J").End(xlUp).Row   'предыдущ.посл.строка в столбце J
                                                           'с учетом строк Сумма и Сальдо
          Range("B4:I" & iLR + 2).Borders.Weight = xlThin  'границы таблицы
          Range(Cells(iLR + 1, "B"), Cells(iLR + 2, iLastCol)).ClearContents
          Cells(iLR + 1, "B") = "Итого"                    'вставляем Итого, Сальдо и считаем
          Cells(iLR + 2, "B") = "Сальдо"                   'соответств. суммы
          Cells(iLR + 1, "F").Formula = "=Sum(F4:F" & iLR & ")"   'сумма по F
          Cells(iLR + 1, "G").Formula = "=Sum(G4:G" & iLR & ")"   'сумма по G
          Cells(iLR + 1, "H").Formula = "=Sum(H4:H" & iLR & ")"   'сумма по H
          Cells(iLR + 1, "I").Formula = "=Sum(I4:I" & iLR & ")"   'сумма по I
          Cells(iLR + 2, "F").Formula = "=F" & iLR + 1 & "- H" & iLR + 1
          Cells(iLR + 2, "G").Formula = "=G" & iLR + 1 & "- I" & iLR + 1
             'формулы для столбцов J:M строка Итого iLR + 1
          Cells(iLR + 1, "J").Formula = "=F" & iLR + 1 & "- N" & iLR + 1
          Cells(iLR + 1, "K").Formula = "=G" & iLR + 1 & "- O" & iLR + 1
          Cells(iLR + 1, "L").Formula = "=H" & iLR + 1 & "- P" & iLR + 1
          Cells(iLR + 1, "M").Formula = "=I" & iLR + 1 & "- Q" & iLR + 1
             'формулы для столбцов J:M строка Сальдо iLR + 2
          Cells(iLR + 2, "J").Formula = "=J" & iLR + 1 & "- L" & iLR + 1
          Cells(iLR + 2, "K").Formula = "=K" & iLR + 1 & "- M" & iLR + 1
          Cells(iLR + 2, "L").Formula = "=H" & iLR + 2 & "- P" & iLR + 2
          Cells(iLR + 2, "M").Formula = "=I" & iLR + 2 & "- Q" & iLR + 2
             'копируем диапазон с формулами сумм F:I до iLastCol - 3
          For j = 14 To iLastCol - 3 Step 4
            Range(Cells(iLR + 1, "F"), Cells(iLR + 1, "I")).Copy Cells(iLR + 1, j)
          Next
             'проверяем число строк iLR и сравниваем с предыдущим значением iLR_old
          If iLR + 2 >= iLR_old Then 'копируем формулы с строки iLR_old -2
             'убираем старую заливку строк Итого и Сальдо от столбца J и правее
            Range(Cells(iLR_old - 1, "J"), Cells(iLR_old, iLastCol)).Interior.ColorIndex = xlNone
            Range(Cells(iLR_old - 2, "J"), Cells(iLR_old - 2, iLastCol)).Copy
            Range(Cells(iLR_old - 1, "J"), Cells(iLR, iLastCol)).PasteSpecial xlPasteFormulas
          Else
            Rows(iLR + 3 & ":" & iLR_old).Delete   'удаляем лишние строки
          End If
          Range(Cells(iLR + 1, "F"), Cells(iLR + 2, "M")).NumberFormat = "#,##0.000"
          Range(Cells(iLR + 1, "F"), Cells(iLR + 1, iLastCol)).NumberFormat = "#,##0.000"
          Range(Cells(iLR + 1, "B"), Cells(iLR + 2, iLastCol)).Interior.ColorIndex = 15
          Cells(iLR + 1, "B").Activate
        End With
          Sht.Activate                          'активируем лист Общ
          Sht.AutoFilter.Range.AutoFilter       'возвращаем все значения автофильтра
    Next
Application.ScreenUpdating = True
End Sub