Sub Summen()
Const Namenspalte = 1
Const Wertspalte = 3
Const Suchbegriff = "Wert"
Const startzeile = 2
Dim zeile As Long, Zielzeile As Long, Endzeile As Long
Dim Quelle As Object, Ziel As Object
Set Quelle = ActiveSheet
Set Ziel = Sheets.Add(after:=Sheets(Sheets.Count))
Endzeile = Quelle.Cells(Rows.Count, Wertspalte).End(xlUp).Row
zeile = startzeile
Zielzeile = 1
Do
If Quelle.Cells(zeile, Wertspalte) = Suchbegriff Then
Zielzeile = Zielzeile + 1
Ziel.Cells(Zielzeile, 1) = Quelle.Cells(zeile, Namenspalte).Value
zeile = zeile + 1
While Quelle.Cells(zeile, Wertspalte) <> Suchbegriff And zeile < Endzeile
zeile = zeile + 1
Wend
If zeile < Endzeile Then zeile = zeile - 1
Ziel.Cells(Zielzeile, 2) = Quelle.Cells(zeile, Wertspalte).Value
End If
zeile = zeile + 1
Loop Until zeile > Quelle.Cells(Rows.Count, Wertspalte).End(xlUp).Row
End Sub