Ich habe in den Sheets Jänner bis Dezember den unteren Code zum einfärben verschiedener Werte.
Könnte man diesen Code nicht in ein Modul legen,so das dieser Automatisch auf die Sheets Jänner bis Dezember zugreift ?
Gruß
Heinz
Sub worksheet_change(ByVal Target As Range)
Dim Name_Bereich, Kal_Bereich As Range, Zelle As Range
Dim wks As Worksheet, FarbeZ As Long, FarbeF As Long, Zeile As Long
Set Kal_Bereich = Range("C3:AI154") 'Bereich in dem was geändert wird
Set Name_Bereich = Range("A3:B154") 'Bereich mit Name und Schicht
Set Kal_Bereich = Intersect(Kal_Bereich, Target)
Set Name_Bereich = Intersect(Name_Bereich, Target)
If Not Kal_Bereich Is Nothing Then
For Each Zelle In Kal_Bereich
'Farben entsprechend Wert in Zelle setzen
Select Case UCase(Zelle.Value) ' UMWANDLUNG DER Eingabe in _
Großbuchstaben für Formatierung
Case "A= ANDERE ABWESENHEIT"
FarbeZ = 21: FarbeF = 2 'violett - weiß
Case "A"
FarbeZ = 21: FarbeF = 2 'violett - weiß
Case Else
FarbeZ = 2: FarbeF = 0
End Select
With Zelle
.Interior.ColorIndex = FarbeZ
.Font.ColorIndex = FarbeF
End With
Next Zelle
ElseIf Not Name_Bereich Is Nothing Then
For Each Zelle In Name_Bereich
Zeile = Zelle.Row
'Farben entsprechend Wert in Spalte B setzen
Select Case UCase(Cells(Zeile, 2)) ' UMWANDLUNG DER Eingabe in _
Großbuchstaben für Formatierung
'######## Nullwerte in Spalte B #######
Case "0"
FarbeZ = 2: FarbeF = 1 'weiß - schwarz
Case Else
FarbeZ = xlColorIndexNone: FarbeF = xlColorIndexAutomatic
End Select
'Zellen in Spalte A und B in allen Monatsblättern formatieren
For Each wks In ActiveWorkbook.Worksheets
Select Case wks.Name
Case "Jänner", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", _
"September", "Oktober", "November", "Dezember", "Krank"
With wks
'Spalten A und B der Zeile formatieren
With .Range(.Cells(Zeile, 1), .Cells(Zeile, 2))
.Interior.ColorIndex = FarbeZ
.Font.ColorIndex = FarbeF
End With
End With
Case Else
'In Tabellen mit anderen Namen nichts ändern
End Select
Next
Next
End If
End Sub