Hallo Simon!
Hier mal eine Variante mit der du arbeiten und die du ausbauen kannst. Bitte erst an einer Testdatei und nicht der richtigen probieren. Ist soweit ich das aus deinen Post rausfiltern konnte erstellt. Ggf. kann du noch Anpassungen vornehmen - bspw. bei Farbe oder bla. Und da du ja ein Tabellenblatt mit "festem" Namen anlegst, kannst du es nur einmal fehlerfrei durchlaufen lassen. Beim zweiten Durchlauf kommt ggf. ein Fehler, da du zwei Blätter mit selbem Namen erstellen willst, das geht natürlich nicht. Könnte man noch abfangen. Genauso könnte man noch an der Geschwindigkeit feilen aber so kannst du mE erstmal starten.

Viele Grüße und nen Guten Rutsch

Sub zeilen_löschen()
'löscht bestimmte Zeilen nach voragben
Dim farbe As Long
Dim bla As Variant
Dim zeilenanzahl As Long
Dim quelltab As Object
Dim zeile As Long
Dim neublatt As Boolean
Dim neu As Object
Dim letztespalte As Long
Dim blattname As String
Dim löschen As Range
Dim formel As String

Application.ScreenUpdating = False
'werte festlegen
Set quelltab = ActiveWorkbook.Worksheets(1)
farbe = 43  'grün, ggf. anpassen
bla = "irgendwas"
neublatt = False
blattname = "NeuesBlatt"
Set löschen = Union(quelltab.Columns(4), quelltab.Columns("F:L"), quelltab.Columns("N:Y"), quelltab.Columns(27))

zeilenanzahl = quelltab.UsedRange.Rows.Count

'alle Zeilen durchgehen
For zeile = zeilenanzahl To 2 Step -1
    If quelltab.Cells(zeile, 1).Interior.ColorIndex = farbe Or quelltab.Cells(zeile, 2) = bla Or quelltab.Cells(zeile, 2) = "" Then
        quelltab.Rows(zeile).Delete
    Else
        'Prüfung auf 0 und dann kopieren
        If quelltab.Cells(zeile, 6) = 0 Then
            'Prüfung ob das Blatt schon eingefügt wurde
            If neublatt = False Then
                Set neu = ActiveWorkbook.Worksheets.Add(after:=Worksheets(Worksheets.Count))
                neu.Name = blattname
                quelltab.Select
                quelltab.Rows(1).Copy neu.Cells(1, 1)
                neublatt = True
            End If
            
            'kopieren
            neu.Rows("2").Insert Shift:=xlDown
            quelltab.Rows(zeile).Copy neu.Cells(2, 1)
        End If
    End If
Next zeile

'löschen
löschen.Delete
'nochmal die Werte anpassen
letztespalte = quelltab.UsedRange.Columns.Count + 1
zeilenanzahl = quelltab.UsedRange.Rows.Count
'Formel eintragen

For zeile = zeilenanzahl To 2 Step -1
    formel = "=(D" & zeile & "-(F" & zeile & "*-1000/C" & zeile & "))/(F" & zeile & "*-1000/C" & zeile & ")"
    If quelltab.Cells(zeile, 6) <> 0 Then quelltab.Cells(zeile, letztespalte).FormulaLocal = formel
Next zeile

Application.ScreenUpdating = True
End Sub