Einfügen funktioniert nach Einbau Makro nicht

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strSuch As String, Zelle As Range, Bere As Range
Application.ScreenUpdating = False
Cells.FormatConditions.Delete
If Selection.Count  Cells(Target.Row, 1).Address Then
Set Zelle = Cells(Zelle.Row, Target.Column)
Zelle.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="0"
Zelle.FormatConditions(1).Interior.ColorIndex = 37
End If
Else
For Each Bere In Selection
strSuch = Cells(Bere.Row, 1)
Set Zelle = Range("A:A").Find(what:=strSuch, after:=Cells(Bere.Row, 1))
If Not Zelle Is Nothing And Zelle.Address  Cells(Bere.Row, 1).Address Then
Set Zelle = Cells(Zelle.Row, Bere.Column)
Zelle.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="0"
Zelle.FormatConditions(1).Interior.ColorIndex = 37
End If
Next Bere
End If
Application.ScreenUpdating = True
End Sub

vielen Dank
Joerg