Sub test()
  Const w0 = 2  'wiersz początkowy danych

  Dim suma As Double, ogolem As Double
  Dim oldInd As String
  Dim w As Long
  Dim T(), wT As Long         'tablica na sumy
  Dim bDalej As Boolean

  wT = -1
  ogolem = 0
  oldInd = Cells(w0, "A")
  suma = Cells(w0, "B")

  'powtarzaj aż napotkasz pustą komórkę w kolumnie A
  w = w0 + 1
  bDalej = True
  Do
    If Cells(w, "A") = oldInd Then
      suma = suma + Cells(w, "B")
    Else
      'zapamiętanie obliczeń
      ogolem = ogolem + suma
      wT = wT + 1
      ReDim Preserve T(1, wT)
      T(0, wT) = oldInd
      T(1, wT) = suma
      'wstawienie wiersza
      Cells(w, "A").EntireRow.Insert xlDown
      w = w + 1
      oldInd = Cells(w, "A")
      If oldInd = "" Then bDalej = False 'flaga wyjścia z pętli
      suma = Cells(w, "B")
    End If
    w = w + 1
  Loop While bDalej

  'wstawienie ogółem do tablicy
  wT = wT + 1
  ReDim Preserve T(1, wT)
  T(0, wT) = "suma"
  T(1, wT) = ogolem

  'zapisanie sum w arkuszu
  Cells(w, "A").Resize(wT + 1, 2) = WorksheetFunction.Transpose(T)

End Sub