Korrektur für die letzte Zeile
Option Explicit

Sub Rechnen()
Dim Bereich As Range
Dim Start As Range, sucheG1 As Range, sucheG2 As Range, Suchbegriff As String
Dim ZeileG1 As Long, ZeileG2 As Long, AnzahlZeilen As Long
Dim ErsteAddresse As String

Suchbegriff = "G"

'For Each Suchbegriff In Bereich.Cells
With ActiveSheet.Range("A1:A500000").Cells
  Set Start = .Find(Suchbegriff, After:=Range("A1"), LookIn:=xlValues)
  Set sucheG1 = Start
  ErsteAddresse = Start.Address
  Debug.Print ErsteAddresse
   Do
    Set sucheG2 = .FindNext(sucheG1)
    If sucheG2.Address <> ErsteAddresse Then
      ZeileG2 = sucheG2.Row
    Else
      ZeileG2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    End If
      ZeileG1 = sucheG1.Row + 1
      AnzahlZeilen = ZeileG2 - ZeileG1
'      sucheG1.Offset(0, 3).FormulaR1C1 = "=SUMIF(R[" & 1 & "]C[-3]:R[" & AnzahlZeilen & "]C[-3],""P"",R[" & 1 & "]C:R[" & AnzahlZeilen & "]C)"
      sucheG1.Offset(0, 3).FormulaR1C1 = "=SUM(R[1]C:R[" & AnzahlZeilen & "]C)"
    Set sucheG1 = sucheG2
  Loop While sucheG1.Address <> ErsteAddresse
End With
End Sub