Sub zeilen_löschen()
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
Set quelltab = ActiveWorkbook.Worksheets("Reporting")
farbe = 43
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
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
If quelltab.Cells(zeile, 6) = 0 Then
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
neu.Rows("2").Insert Shift:=xlDown
quelltab.Rows(zeile).Copy neu.Cells(2, 1)
quelltab.Rows(zeile).Delete
End If
End If
Next zeile
löschen.Delete
If neublatt = True Then
Set löschen = Union(neu.Columns(4), neu.Columns("F:L"), neu.Columns("N:Y"), neu.Columns(27))
löschen.Delete
End If
letztespalte = quelltab.UsedRange.Columns.Count + 1
zeilenanzahl = quelltab.UsedRange.Rows.Count
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
quelltab.Cells(zeile, letztespalte).Interior.ColorIndex = 6
End If
Next zeile
Application.ScreenUpdating = True
End Sub