Workbook SheetChange Änderung

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim lngS As Long, arrA, rngA As Range, rngC As Range, aa As Long
With Sheets("Legende")
If .Name = Sh.Name Then Exit Sub
lngS = .Cells(.Rows.Count, 1).End(xlUp).Row
arrA = Application.Transpose(.Cells(2, 1).Resize(lngS))
End With
For Each rngA In Target.Areas
For Each rngC In rngA
If Not IsEmpty(rngC) Then
For aa = 1 To UBound(arrA) Step 2
If IsError(rngC) And Not IsError(arrA(aa)) Then
ElseIf Not IsError(rngC) And IsError(arrA(aa)) Then
ElseIf rngC = arrA(aa) Then
With Sheets("Legende").Cells(aa + 1, 2)
rngC.NumberFormat = .NumberFormat               ' Zahlenformat
rngC.Font.ColorIndex = .Font.ColorIndex         ' Schriftfarbe
With .Interior                                  ' Hintergrund
rngC.Interior.ColorIndex = .ColorIndex
rngC.Interior.Pattern = .Pattern     ' Muster
rngC.Interior.PatternColorIndex = .PatternColorIndex
End With
With .Borders                                   ' Rahmen
rngC.Borders.Weight = .Weight
rngC.Borders.ColorIndex = .ColorIndex
rngC.Borders.LineStyle = .LineStyle
End With
End With
Exit For
End If
Next aa
End If
If aa = 0 Or aa > UBound(arrA) Then
With rngC
.NumberFormat = "General"                       ' Zahlenformat
.Font.ColorIndex = xlColorIndexAutomatic        ' Schriftfarbe
With .Interior                                  ' Hintergrund
.ColorIndex = xlColorIndexAutomatic
.Pattern = xlPatternNone             ' Muster
End With
.Borders.LineStyle = xlLineStyleNone            ' Rahmen
End With
End If
Next rngC
Next rngA
End Sub