Option
Explicit
Private
Sub
Workbook_SheetChange(
ByVal
Sh
As
Object
,
ByVal
Target
As
Range)
Dim
AnzahlNamen
As
Integer
Dim
RaBereich
As
Range
Dim
RaZelle
As
Range
If
Not
Sh
Is
Worksheets(
"Überblick"
)
Then
AnzahlNamen = Worksheets(
"Admin"
).Cells(4, 3).Value
With
Sh
Set
RaBereich = .Range(.Cells(6, 2), .Cells(30 + AnzahlNamen, 93))
End
With
Set
RaBereich = Intersect(RaBereich, Target)
If
Not
RaBereich
Is
Nothing
Then
For
Each
RaZelle
In
RaBereich
With
Range(RaZelle.Address, RaZelle.Offset(0, 0).Address)
Select
Case
UCase(RaZelle.Value)
Case
"U"
.Interior.Color = Worksheets(
"Überblick"
).Cells(6, 15).Interior.Color
.Font.Color = Worksheets(
"Überblick"
).Cells(6, 15).Font.Color
Case
"Z"
.Interior.Color = Worksheets(
"Überblick"
).Cells(6, 18).Interior.Color
.Font.Color = Worksheets(
"Überblick"
).Cells(6, 18).Font.Color
Case
"B"
.Interior.Color = Worksheets(
"Überblick"
).Cells(6, 21).Interior.Color
.Font.Color = Worksheets(
"Überblick"
).Cells(6, 21).Font.Color
Case
"L"
.Interior.Color = Worksheets(
"Überblick"
).Cells(6, 24).Interior.Color
.Font.Color = Worksheets(
"Überblick"
).Cells(6, 24).Font.Color
Case
"S"
.Interior.Color = Worksheets(
"Überblick"
).Cells(6, 27).Interior.Color
.Font.Color = Worksheets(
"Überblick"
).Cells(6, 27).Font.Color
Case
Else
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlAutomatic
.NumberFormat =
"General"
End
Select
End
With
Next
RaZelle
End
If
Set
RaBereich =
Nothing
End
If
End
Sub