Sub test()

     i = 2
     cPriz = "~"
      
     Do
         If Cells(i, 1) & Cells(i, 2) <> cPriz And cPriz <> "~" Then
             Rows(i).Insert
             Cells(i, 1) = "Итого с признаком '" & Cells(i - 1, 2) & "':"
             Cells(i, 1).Resize(, 3).Interior.ColorIndex = 40
             Cells(i, 3) = nSum
             Cells(i, 1).Resize(, 2).Merge
             cPriz = "~"
         Else
             If cPriz = "~" Then
                 nSum = 0
                 If Left(Cells(i, 1), 5) <> "Итого" Then
                     cPriz = Cells(i, 1) & Cells(i, 2)
                 End If
             End If
             If Cells(i, 1) & Cells(i, 2) = cPriz Then
                 nSum = nSum + Cells(i, 3)
             End If
         End If
         i = i + 1
     Loop Until Cells(i, 1) = ""
      
End Sub

Sub Test()
     Dim arr(), arr2(), i&, y&, it, arr1
     Application.ScreenUpdating = False
     With Sheets(1)
         arr = .Range("A2:C" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
     End With
     With CreateObject("Scripting.Dictionary")
         For i = LBound(arr, 1) To UBound(arr, 1)
             If arr(i, 1) <> "Итого по группе 1:" Then
                 it = arr(i, 1) & "@@" & arr(i, 2)
                 .Item(it) = .Item(it) + arr(i, 3)
             End If
         Next i
          
         ReDim arr2(1 To .Count, 1 To 3)
         y = 1
         For Each it In .Keys
             arr1 = Split(it, "@@")
             arr2(y, 1) = arr1(0)
             arr2(y, 2) = arr1(1)
             arr2(y, 3) = .Item(it)
             y = y + 1
         Next it
     End With
     With Sheets(3)
         .Cells.Clear
         .[a1].Resize(y - 1, 3).Value = arr2
         .Activate
     End With
     Application.ScreenUpdating = True
End Sub

Sub test()

     Application.ScreenUpdating = False
      
     i = 17
     cPriz = "~"
      
     Do
         If Cells(i, 2) <> cPriz And cPriz <> "~" Then
             Rows(i).Insert
             Cells(i, 2) = "Итого с признаком '" & Cells(i - 1, 2) & "':"
             Cells(i, 2).Resize(, 4).Interior.ColorIndex = 36
             Cells(i, 3) = nSum
             'Cells(i, 1).Resize(, 2).Merge
             cPriz = "~"
         Else
             If cPriz = "~" Then
                 nSum = 0
                 If Cells(i, 2) = "X" Or Cells(i, 2) = "" Then
                     cPriz = Cells(i, 2)
                 End If
             End If
             If Cells(i, 2) = cPriz Then
                 nSum = nSum + Cells(i, 3)
             End If
         End If
         i = i + 1
     Loop Until Left(Cells(i, 1), 5) = "Всего"
      
     Application.ScreenUpdating = True
      
End Sub