Warum funktioniert die Union hier nicht
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Union(Range("D7:IV7"), Range("D10:IV10"), Range("D13:IV13"), Range("D16:IV16"), Range("D19:IV19"), Range("D22:IV22"), Range("D25:IV25"), Range("D28:IV28"), Range("D31:IV31"), Range("D34:IV34"), Range("D37:IV37"), Range("D40:IV40"), Range("D43:IV43"), Range("D46:IV46"), Range("D49:IV49"), Range("D52:IV52"), Range("D55:IV55"), Range("D58:IV58"), Range("D61:IV61"), Range("D64:IV64"), Range("D67:IV67"), Range("D70:IV70"), Range("D73:IV73"), Range("D76:IV76"), Range("D79:IV79"), Range("D82:IV82"), Range("D85:IV85"), Range("D88:IV88"), Range("D91:IV91"), Range("D94:IV94"), Range("D97:IV97"), Range("D100:IV100"), Range("D103:IV103"), Range("D106:IV106"), Range("D109:IV109"), Range("D112:IV112"), Range("D115:IV115"), Range("D118:IV118"), Range("D121:IV121"), Range("D124:IV124"), Range("D127:IV127"), Range("D130:IV130"), Range("D133:IV133"), Range("D136:IV136"), Range("D139:IV139"), Range("D142:IV142"), Range("D145:IV145"), Range("D148:IV148"), Range("D151:IV151"), Range("D154:IV154"))
For Each RaZelle In RaBereich
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
With RaZelle
Select Case RaZelle.Value
Case "1"
RaZelle.Interior.Color = RGB(255, 204, 153)
RaZelle.Font.Color = RGB(255, 204, 153)
Case "2"
RaZelle.Interior.Color = RGB(255, 153, 0)
RaZelle.Font.Color = RGB(255, 153, 0)
Case "3"
RaZelle.Interior.Color = RGB(153, 51, 0)
RaZelle.Font.Color = RGB(153, 51, 0)
Case "4"
RaZelle.Interior.Color = RGB(153, 204, 255)
RaZelle.Font.Color = RGB(153, 204, 255)
Case "5"
RaZelle.Interior.Color = RGB(51, 102, 255)
RaZelle.Font.Color = RGB(51, 102, 255)
Case "6"
RaZelle.Interior.Color = RGB(0, 0, 128)
RaZelle.Font.Color = RGB(0, 0, 128)
Case Else
RaZelle.Interior.ColorIndex = 0
RaZelle.Font.ColorIndex = 0
End Select
End With
End If
Next RaZelle
Set RaBereich = Nothing
End Sub