Szia!

Közben megszületett az új verzió:

Sub FormatText2()
Dim i As Double, mycell As Range, myfind As Range, elso As String
Set myfind = Range("H:H").Find(what:="w", LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
If Not myfind Is Nothing Then
elso = myfind.Address
Do While True
Set mycell = Range("H:H").Find(what:="p", LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious, after:=myfind)
If Not mycell Is Nothing Then
i = myfind.Row
With Range("A" & i & ":H" & i)
.Font.Name = "Calibri"
.Font.FontStyle = "Italic"
.Font.Underline = xlUnderlineStyleSingle
End With
Range("E" & i).Value = Range("A" & i).Value & " " & Range("D" & i).Value
Range("E" & i).HorizontalAlignment = xlRight
Range("A" & i & ":D" & i).ClearContents
Range("F" & i).Formula = "=Sum(" & Range("F" & i - 1).Address & ":" & Range("F" & mycell.Row).Address & ")"
End If
Set myfind = Range("H:H").Find(what:="w", LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext, after:=myfind)
If myfind.Address = elso Then Exit Do
Loop
End If
End Sub

Ennek az az előnye, hogy nem kell végigpörgetni az összes cellát, hogy megtaláld a w betűket, ezt rá kell bízni az Excelre - azért találták ki.
Feltétlenül fontos, hogy az első csoportösszesítés kezdetéhez is tegyél egy p betűt.

Üdv.