Performance erhöhen - Zelleninhalte leeren

Sub HideRowIFWahr()
'Alle Zeilen, deren Wert in Spalte A WAHR ist,
'sollen "en bloc" ausgeblendet und deren
'nicht geschützte Zellen geleert werden.
On Error Resume Next
With Application
.ScreenUpdating = False
.Calculation = xlManual
.Cursor = xlWait
.EnableEvents = False
End With
Dim rng As Range
Dim iRow As Integer
Dim iRowL As Integer
Dim Zelle As Range
Dim rngNotLocked As Range
Dim LetzteSpalte As Integer
' erstmal alle Zeilen einblenden
Cells.EntireRow.Hidden = False
' dann letzte Zeile mit Wert in Spalte A bestimmen
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
For iRow = 1 To iRowL
' Letzte Spalte der aktuellen Zeile iRow ermitteln
LetzteSpalte = ActiveSheet.Cells(iRow, 256).End(xlToLeft).Column
' Dann alle Zellen in Spalte A mit WAHR finden
If Cells(iRow, 1).Value = True Then
For Each Zelle In ActiveSheet.Range(Cells(iRow, 1), Cells(iRow, LetzteSpalte))
If Zelle.Locked = False Then
If rngNotLocked Is Nothing Then
Set rngNotLocked = Zelle
End If
Set rngNotLocked = Application.Union(rngNotLocked, Zelle)
End If
Next Zelle
' Inhalt der Gefundenen Zellen leeren
rngNotLocked.Value = ""
' Alle Zeilen mit WAHR in SPALTE A finden
' Wenn WAHR zum ersten Mal vorkommt
If rng Is Nothing Then
Set rng = Cells(iRow, 1)
' Wenn WAHR mehrfach vorkommt, bilde Mehrfachselektion
Else
Set rng = Application.Union(rng, Cells(iRow, 1))
End If
End If
Next iRow
' Falls gar keine Zeile zum Ausblenden gefunden wurde
If rng Is Nothing Then GoTo errorhandler
' Ansonsten blende die gefundene(n) Zeile / Zeilen aus
rng.EntireRow.Hidden = True
errorhandler:
With Application
.ScreenUpdating = True
.Calculation = xlAutomatic
.Cursor = xlDefault
.EnableEvents = True
.StatusBar = ""
End With
End Sub