Sub Rio_Merge()
Application.ScreenUpdating = False: Application.DisplayAlerts = False
With ThisWorkbook.Sheets(1)

'Made by Roman "Rioran" Voronov
'For www.excelworld.ru user
'Any help: voronov_rv@mail.ru

Dim X As Long: X = 7 'Row runner
Dim Y As Long: Y = 6 'Low bound for merging
Dim Z As Long: Z = 0 'For merging small columns
Dim EndX As Long: EndX = .Cells(Rows.Count, 1).End(xlUp).Row 'To know our limits

Do While X < EndX + 2
     If .Cells(X, 1).Value <> .Cells(X - 1, 1).Value Then
         .Range("A" & Y & ":A" & X - 1).Merge
         .Rows(X).Insert Shift:=xlDown
         .Range("A" & X & ":B" & X).Merge
         .Range("C" & X & ":L" & X).Value = "X"
         .Range("A" & X & ":B" & X).Value = "Итого за " & .Cells(Y, 1).Value
         EndX = EndX + 1: X = X + 1: Y = X
     End If
     X = X + 1
Loop

X = 7: Y = 6

Do While X < EndX + 2
     If .Cells(X, 3).Value = .Cells(X - 1, 3).Value Then
         Z = Z + 1
     Else
         If Z > 0 Then
             .Range("B" & X - 1 - Z & ":B" & X - 1).Merge
             .Range("C" & X - 1 - Z & ":C" & X - 1).Merge
             .Range("M" & X - 1 - Z & ":M" & X - 1).Merge
             .Cells(X - 1 - Z, 13).Value = Application.Sum(Range("L" & X - 1 - Z & ":L" & X - 1).Value)
             Z = 0
         ElseIf Z = 0 Then
             If .Cells(X - 1, 12).Value = "X" Then
                 .Cells(X - 1, 13).Value = Application.Sum(Range("M" & Y & ":M" & X - 1).Value)
                 Y = X
             Else
                 .Cells(X - 1, 13).Value = .Cells(X - 1, 12).Value
             End If
         End If
     End If
     X = X + 1
Loop

.Range("A4:N" & EndX).Borders.LineStyle = xlContinuous
.Range("A4:N" & EndX).Borders.Weight = xlThin
.Range("A4:N" & EndX).HorizontalAlignment = xlCenter
.Range("A4:N" & EndX).VerticalAlignment = xlCenter

End With
Application.DisplayAlerts = True: Application.ScreenUpdating = True
End Sub