ich habe dieses Löschen-Makro. Es soll zusätzlich der Bereich AR7:AR42 gelöscht werden.
Das komplette Makro:
Rem DatenÜbernahme u.Löschen aller DatenDirektEinträge
Sub Löschen()
Const delAbstdZ As Long = 3, adDelBer1$ = "B9:AF42", adDelBer2$ = "Aq7:Aq42", _
adKorBer1$ = "AH5 AP42", 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
Wie würde das Makro mit der Ergänzung lauten?
Gruß
mike49