Option
Explicit
Private
Sub
Workbook_SheetChange(
ByVal
Sh
As
Object
,
ByVal
Target
As
Range)
Dim
RaBereich
As
Range
Dim
RaZelle
As
Range
Set
RaBereich = Range(
"B6:CO22"
)
Set
RaBereich = Intersect(RaBereich, Target)
If
Not
RaBereich
Is
Nothing
Then
For
Each
RaZelle
In
RaBereich
With
RaZelle
Select
Case
UCase(RaZelle.Value)
Case
"W"
.Interior.Color = Worksheets(
"Überblick"
).Cells(6, 3).Interior.Color
.Font.Color = Worksheets(
"Überblick"
).Cells(6, 3).Font.Color
.Value = Worksheets(
"Überblick"
).Cells(6, 3).Value
Case
"S"
.Interior.Color = Worksheets(
"Überblick"
).Cells(6, 6).Interior.Color
.Font.Color = Worksheets(
"Überblick"
).Cells(6, 6).Font.Color
.Value = Worksheets(
"Überblick"
).Cells(6, 6).Value
Case
"F"
.Interior.Color = Worksheets(
"Überblick"
).Cells(6, 9).Interior.Color
.Font.Color = Worksheets(
"Überblick"
).Cells(6, 9).Font.Color
.Value = Worksheets(
"Überblick"
).Cells(6, 9).Value
Case
"BR"
.Interior.Color = Worksheets(
"Überblick"
).Cells(6, 12).Interior.Color
.Font.Color = Worksheets(
"Überblick"
).Cells(6, 12).Font.Color
.Value = Worksheets(
"Überblick"
).Cells(6, 12).Value
Case
"U"
.Interior.Color = Worksheets(
"Überblick"
).Cells(6, 15).Interior.Color
.Font.Color = Worksheets(
"Überblick"
).Cells(6, 15).Font.Color
.Value = Worksheets(
"Überblick"
).Cells(6, 15).Value
Case
"Z"
.Interior.Color = Worksheets(
"Überblick"
).Cells(6, 18).Interior.Color
.Font.Color = Worksheets(
"Überblick"
).Cells(6, 18).Font.Color
.Value = Worksheets(
"Überblick"
).Cells(6, 18).Value
Case
"B"
.Interior.Color = Worksheets(
"Überblick"
).Cells(6, 21).Interior.Color
.Font.Color = Worksheets(
"Überblick"
).Cells(6, 21).Font.Color
.Value = Worksheets(
"Überblick"
).Cells(6, 21).Value
Case
"L"
.Interior.Color = Worksheets(
"Überblick"
).Cells(6, 24).Interior.Color
.Font.Color = Worksheets(
"Überblick"
).Cells(6, 24).Font.Color
.Value = Worksheets(
"Überblick"
).Cells(6, 24).Value
Case
"SO"
.Interior.Color = Worksheets(
"Überblick"
).Cells(6, 27).Interior.Color
.Font.Color = Worksheets(
"Überblick"
).Cells(6, 27).Font.Color
.Value = Worksheets(
"Überblick"
).Cells(6, 27).Value
Case
Else
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlAutomatic
.NumberFormat =
"General"
End
Select
End
With
Next
RaZelle
End
If
Set
RaBereich =
Nothing
End
Sub