So hats jetzt funktioniert :)
Sheets("Formular").Select Dim S As Shape For Each S In ActiveSheet.Shapes If Not Intersect(S.TopLeftCell, Range("Q28:X76")) Is Nothing Then S.Delete On Error Resume Next Next S