Laufzeitfehler

Sub Neue_Zeile()
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="123"
Dim wks As Worksheet
Dim ZeileSumme As Long, lngNr As Long, Zeile As Long
Dim Spalte As Long
Set wks = ActiveSheet
With wks
'Zeile mit Summen ermitteln
Zeile = 7
lngNr = 0
Do Until .Cells(Zeile, 1) = "Summenzeile"
Zeile = Zeile + 1
lngNr = lngNr + 1
Loop
ZeileSumme = Zeile
'Zeile 7 kopieren und oberhalb der Summenzeile einfügen
.Rows(8).Copy
.Rows(ZeileSumme).Insert
ZeileSumme = ZeileSumme + 1
'fortlaufende Nr. eintragen und in Zellen ohne Formel Inhalte löschen
For Spalte = 1 To 26
With .Cells(Zeile, Spalte)
Select Case Spalte
Case 1
.Value = lngNr
Case 2 To 12, 14 To 17, 19 To 20, 22, 25, 26
'verbundene Zellen
.MergeArea.ClearContents
Case 13, 18, 21, 23, 24
'Formeln nicht löschen
End Select
End With
Next
'in Summenzeile die Formeln anpassen
For Spalte = 1 To 26
With .Cells(ZeileSumme, Spalte)
Select Case Spalte
Case 1 To 6
'keine Formel
Case 10, 12, 16, 17, 20
.MergeArea.ClearContents
'keine Formel
Case 7 To 9, 11, 13 To 15, 18, 19, 21 To 26
'Summenformel
.FormulaR1C1 = "=SUM(R[" & (-ZeileSumme + 7) & "]C:R[-1]C)"
End Select
End With
Next
End With
Cells(Zeile, 2).Select
ActiveSheet.Protect Password:="123"
Application.ScreenUpdating = True
End Sub