Hallo,
ok ersetz Deinen Event-Code mal hiermit, und stell Deine Bereichsauswahl im Code neu ein (hab ich kommentiert) andernfalls würde das Event nicht feuern...
Option Explicit ' Variablendefinition erforderlich
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'***********************************************
'* H. Ziplies *
'* 07.11.12 *
'* erstellt von HajoZiplies@web.de *
'* http://Hajo-Excel.de/ *
'***********************************************
' Fülfarbe
' für Schrift RaZelle.Font.ColorIndex
Dim AnzahlNamen As Integer
Dim RaBereich As Range ' Variable für Bereich
Dim RaZelle As Range ' Variable für Zelle
If Not Sh Is Worksheets("Überblick") Then
AnzahlNamen = Worksheets("Admin").Cells(4, 3).Value
With Sh '// 25 - 20 + //' <<<<<< Dein alter BereichsIndex zu Testzwecken hab ich 30 gewählt mußt Du selbst mal anpassen...
Set RaBereich = .Range(.Cells(6, 2), .Cells(30 + AnzahlNamen, 93)) ' Bereich der Wirksamkeit
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) ' Umwandlung der Eingabe in Großbuchstaben
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 ' Variable leeren
End If
End Sub
Gruß,
|