Sub naechsterSchritt()
Dim LetzteZeile as long
dim i as long
dim ZeileStempKart as long
ZeileStempKart = 5
LetzteZeile = Worksheets("Hauptliste").Cells(Rows.Count, 6).End(xlUp).Row
For i = 2 To letzte Zeile
If Worksheets("Hauptliste").cells(i,1).value = "Stempelaktion" Then
Worksheets("Hauptliste").cells(i,2).Copy Destination:=Worksheets("Stempelkarten").cells(ZeileStempKart,1)
Worksheets("Hauptliste").Range("C2").Copy Destination:=Worksheets("Stempelkarten").Range("F5 ")
ZeileStempKart = ZeileStempKart + 1
End If
Next i