Füge ein leeres blatt mit namen "NeuesBlatt" hinzu.

Füge auf Blatt "Tabelle1" ein Formularsteuerelement "Schaltfläche" mit dem Text "OK" hinzu und plaziere ihn in Z1S1, mache ihn so klein, daß die Spaltenbeschriftung

lesbar ist (evtl Spalte etwas breiter machen) - Wenn dein Blatt1 nicht "Tabelle1" heisst, unten im makro anpassen.

Weise der Schaltfläche dieses Makro zu:

Sub makro1()
such$ = "bla" ' Hier "bla" eingeben
zmax = 1000: 'Hier maximale zu durchsuchende Zeilenanzahl eingeben
Sheets("Tabelle1").Select: ' Hier ggf Namen ändern
For Z = 2 To zmax
    a = Cells(Z, 1):    b = Cells(Z, 2)
    If a = "" Then Exit For
    If b = 2 Or b = such$ Or Cells(Z, 1).Interior.ColorIndex = 43 Then
        Rows(Z).Delete
        Z = Z - 1
    End If
Next Z
zz = 1
Sheets("NeuesBlatt").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("Tabelle1").Select:' Hier ggf Namen ändern
For Z = 1 To zmax
    b = Cells(Z, 6)
    If Z = 1 Or (b <> "" And b = 0) Then
        Rows(Z).Select
        Selection.Copy
        Sheets("NeuesBlatt").Select
        Cells(zz, 1).Select
        ActiveSheet.Paste
        
        Sheets("Tabelle1").Select: ' Hier ggf Namen ändern
        zz = zz + 1
    Else
        If Z > 1 Then Cells(Z, 28) = "ok"
        'Zeilen markieren, wo Formel hinein soll
    End If
Next Z
' Unerwünschte Spalten löschen
Columns(27).Select
Selection.Delete
Range(Columns(14), Columns(25)).Select
Selection.Delete
Range(Columns(6), Columns(12)).Select
Selection.Delete
' Wenn Zeile markiert, Formel in (neue) Spalte 8 eingeben
For Z = 2 To zmax
    If Cells(Z, 8) = "ok" Then
        Cells(Z, 8).FormulaR1C1 = "=(RC4-(RC6*-1000/RC3))/(RC6*-1000/RC3)"
    End If
Next Z
Cells(1, 1).Select
End Sub

Viel Spaß damit!