Also z.B. Tabelle 1 und 3 und 8 wird mit dem Code formatiert... alle anderen Tabellen bleben ausgeschlossen.
Der Code:
Option Explicit
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