Option Explicit
Sub test()
Const bln As Boolean = False
Dim c As Range
Dim x As Long, y As Long, z As Long
Application.ScreenUpdating = False
z = 1: If bln Then z = z + 1
Set c = ActiveSheet.UsedRange.Find(What:="Summen", SearchDirection:=xlPrevious)
If c Is Nothing Then Exit Sub
y = c.Offset(0, 3).Column
For x = c.Row To z Step -1
If Cells(x, y).Value = 0 Then Rows(x).Delete
Next x
Set c = ActiveSheet.UsedRange.Find(What:="Summen", SearchDirection:=xlPrevious)
If c Is Nothing Then Exit Sub
y = c.Column
For x = c.Row To z Step -1
If Cells(x, y).Value = "Summen" Then Rows(x + 1).Insert Shift:=xlDown
Next x
Application.ScreenUpdating = True
End Sub