subtotal 4.Zeile bis 4.letzte Zeile

Sub A1_CallCodeAuswertung_auswerten()
'Datei verkleinern
Dim Lrow As Long, i As Long
Dim intZeilenanzahl%
Application.ScreenUpdating = False  'vielleicht geht es ohne "zuschauen" schneller
Lrow = Cells(Rows.Count, 5).End(xlUp).Row
'Spalte E "ActivityTime" ab-arbeiten
For i = Lrow To 4 Step -1
If Cells(i, 1) = "" Then
Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True
'letzte Zeile in A suchen
intZeilenanzahl = 0
intZeilenanzahl = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Cells(intZeilenanzahl + 2, 1).Activate      'und aktiviert
ActiveCell.FormulaR1C1 = "Zwischensumme"
Cells(intZeilenanzahl + 2, 4).Activate       ' bis hierher läuft alles prima
ActiveCell.FormulaR1C1 = "=SUBTOTAL(Cells(intZeilenanzahl - 2, 4):cells(4,4))"
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="falsch"
End Sub