|
Versuchs mal damit:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strInhalt As String
If Target.Address <> "$D$6" Then Exit Sub
strInhalt = Target
With Sheets("1")
.Activate
Select Case strInhalt
Case Is = "Name 1"
.Range("F9:F42,I9:I42,J9:J42,M9:M42,P9:P42,Q9:Q42").Select
With Selection.Interior
.Pattern = xlCrissCross
.PatternColorIndex = xlAutomatic
End With
Case Is = "Name 2"
.Range("F9:F42,I9:I42,J9:J42,M9:M42,P9:P42,Q9:Q42").Select
With Selection.Interior
.Pattern = xlCrissCross
.PatternColorIndex = xlAutomatic
End With
Case Is = "Name 3"
.Range("F9:F42,I9:J42,M9:M42,P9:Q42").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Case Is = "Name 4"
.Range("F9:F42,I9:J42,M9:M42,P9:Q42").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Case Is = "Name 5"
.Range("F9:F42,I9:J42,M9:M42,P9:Q42").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End Select
End With
'Sheets("Inhalt").Activate 'ggf. aktivieren
End Sub
|