Löschen-Makro erweitern

Sub Löschen()
Const delAbstdZ As Long = 3, adDelBer1$ = "B9:AF42", adDelBer2$ = "AR7:AS42", _
adKorBer1$ = "AH5 AQ42", adKorBer2$ = "N5 V5" ', adKorBer3$ = "AH9"
Dim i As Long, delBer As Range
On Error GoTo fx
With Application
.ScreenUpdating = False  'Bildschirmaktualisierung abschalten.
With Kalender
Set delBer = .Range(adDelBer1)
.Unprotect
.Range(Split(adKorBer1)(0)).Value = .Range(Split(adKorBer1)(1)).Value
.Range(Split(adKorBer2)(0)).Value = .Range(Split(adKorBer2)(1)).Value
For i = 1 To delBer.Rows.Count Step delAbstdZ
delBer.Rows(i).ClearContents
Next i
.Range(adDelBer2).ClearContents
'            .Range(Split(adKorBer2)(0)).ClearContents
'            .Range(adKorBer3).Formula = "=IF(COUNT(RC[-32]:RC[-2])=0,0,R[-3]C[1])"
With .Range("B7:AG42").Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Color = 0
.Weight = xlThin
End With
.Range(adJahrZ) = .Range(adJahrZ) + 1 'F3 wird mit jedem Klick auf den LöschenButton erhöht
.Protect
End With
.CalculateFullRebuild
.ScreenUpdating = True   'Bildschirmaktualisierung wieder einschalten.
End With
GoTo ex
fx: If Err.Number  xlErrNA Then
MsgBox Err.Description, vbCritical, "Interner Fehler " & CStr(Err.Number)
Else: MsgBox Err.Description, vbCritical, "Fehler " & CStr(CVErr(Err.Number))
End If
ex: Set delBer = Nothing
End Sub