Hallo zusammen,

von mir erst mal ein herzliches Hallo, bin zum ersten male hier im Forum.
ich habe ein Problem mit dem Laufzeitfehler 1004 (Anwendungs- oder objektdefinierter Fehler)
Leider bin ich mit meinem Latein wirklich am Ende, denn die Zeilen werden einmal ausgeführt und dann nicht mehr.
Kann mir jemand helfen bitte ich bin echt am durchdrehen.

Gruß Alex

Codezeilen in Modul:

Sub durchstreichen()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Prüftabelle")


'Prüftabelle Punkt 7.9-7.11
If ws.Range("Z34") = "x" Then
diagonale ws, "C177", "AG164"
End If

'Prüftabelle Punkt 7.3
If ws.Range("AE34") = "x" Then
diagonale ws, "C149", "AG149"
End If

'Prüftabelle Punkt 7.2
If ws.Range("Z34") = "x" Then
diagonale ws, "C147", "AG147"
End If

'Prüftabelle Punkt 8-9
If ws.Range("AH180") = "x" Then
diagonale ws, "C194", "AG182"
End If

'Prüftabelle Phunkt 10-11
If ws.Range("AH208") = "x" Then
diagonale ws, "C224", "AG210"
End If
___________________________

End Sub

Sub diagonale(ws As Worksheet, startCell As String, endCell As String)
Dim shp As shape 'Shape lässt sich nicht Groß schreiben

Worksheets("Prüftabelle").Unprotect Password:="Pwd"

For Each shp In ws.Shapes
If Not Intersect(shp.TopLeftCell, ws.Range(startCell & ":" & endCell)) Is Nothing Then 'Hier wird der Fehler markiert
shp.Delete
End If
Next shp

Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
x1 = ws.Range(startCell).Left
y1 = ws.Range(startCell).Top + ws.Range(startCell).Height
x2 = ws.Range(endCell).Left + ws.Range(endCell).Width
y2 = ws.Range(endCell).Top

ws.Shapes.AddLine x1, y1, x2, y2

Worksheets("Prüftabelle").Protect Password:="Pwd"
End Sub