Hallo,
ich habe im Internet folgenden Code gefunden und für meine Zwecke angepasst. Der Code funktioniert wie gewünscht wenn ich diesen auf das Tabellenblatt einfüge.
Option Explicit ' Variablendefinition erforderlich
Private Sub Worksheet_Change(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 RaBereich As Range ' Variable für Bereich
Dim RaZelle As Range ' Variable für Zelle
Set RaBereich = Range("B6:CO22") ' Bereich der Wirksamkeit
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 "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 ' Variable leeren
End Sub
Auf Knopfdruck wird ein neues Tabellenblatt eingefügt und ein Kalender erstellt.
Nun würde ich gerne den oben aufgeführten Code nicht immer auf jedes Tabellenblatt kopieren. Ist es möglich den Code für die ganze Arbeitsmappe zu nutzen oder bei erstellen des neuen Tabellenblattes den Code automatisch einzutragen?
Vielen Dank für eure Hilfe.
Justin
|