Laufzeitfehler 1004

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Counter As Long
Dim Bereich As Range
With Sheets("Gefahrenaufnahme")
Set Bereich = .Range("E22:E25;J22:J26;O22:O26;T24:T26")
'Hier den Bereich anpassen
Set Target = Application.Intersect(Target, Bereich)
'Set Target = Application.Intersect(Target, Range("E22:E25; J22:J26"))
'Wenn nicht innerhalb des Bereiches wird die Prozedur verlassen
If Target Is Nothing Then Exit Sub
'Sheets("Gefahrenaufnahme").Unprotect Password:="1"
'Errorhandling aktivieren, um im Falle eines Fehlers die Ereignisse am Ende wieder zu  _
aktivieren
On Error GoTo ErrorHandler
'Ereignisse ausschalten, um das Change-Ereignis nicht erneut auszulösen
'Application.EnableEvents = False
Application.DisplayAlerts = False
'Eine Range-Variable deklarieren
Dim rngZelle As Range
'jede Zelle innerhalb des Target-Bereiches durchlaufen
For Each rngZelle In Target
'Prüfen, welche Zellfarbe vorhanden ist
If .Cells(rngZelle.Row, rngZelle.Column).Interior.ColorIndex = xlNone Then
.Cells(rngZelle.Row, rngZelle.Column).Interior.Color = RGB(255, 255, 0)
Exit For
Else
.Cells(rngZelle.Row, rngZelle.Column).Interior.ColorIndex = xlNone
Exit For
End If
Next rngZelle
Counter = 0
For Each rngZelle In .Range("A22:T26")
If Cells(rngZelle.Row, rngZelle.Column).Interior.Color = RGB(255, 255, 0) Then
Counter = Counter + Cells(rngZelle.Row, rngZelle.Column).Value
End If
Next rngZelle
'Endergebnis der Berechnung einfügen
.Cells(28, 4).Value = Counter
Cancel = True
End With
ErrorHandler:
Application.EnableEvents = True   'Ereignisse wieder einschalten
Application.DisplayAlerts = True
End Sub