zu finden.
Ich hoffe ich habe alles richtig gemacht,also vielen Dank und auf bald
Sub Liste_filtern()
With Sheets("Tabelle2")
.Cells.Delete
Rows(1).Copy .Cells(1, 1)
For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(i, 2) <> Cells(i - 1, 2) Then J = 0
If Cells(i, 9) = "Dachrandprofil:" Then J = 1
If J = 1 Then
lz = .Cells(Rows.Count, 1).End(xlUp).Row
Rows(i).Copy .Cells(lz + 1, 1)
Rows(i + 1).Copy .Cells(lz + 2, 1)
J = 0
End If
Next i
End With
End Sub