Hallo,
ich habe hier einen Code der soweit eigentlich funktioniert, aber sobald ich einen der Set RaBereich (hervorgehoben mit Fettschrift) auskommentiere, funktioniert der Code nicht.
Ich benötige aber alle aufgeführten Bereiche. Kann man das vielleicht irgenwie anders lösen ?
Was kann ich tun ? Wer kann helfen ?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim RaBereich As Range
  
   
   'ActiveSheet.Unprotect Password:="skill"

   
    If CallByName(Selection, IIf(Val( _
        Application.Version) > 11, "CountLarge", "Count"), VbGet) = 1 Then
           

Set RaBereich = Union(Range("J:J"), Range("L:L"), Range("N:N"), Range("P:P"), Range("R:R"), Range("T:T"), Range("W:W"), Range("Y:Y"), Range("AA:AA"), Range("AC:AC"), Range("AE:AE"), Range("AG:AG"), Range("AI:AI"), Range("AK:AK"), Range("AM:AM"), Range("AO:AO"))
'Set RaBereich = Union(Range("AR:AR"), Range("AT:AT"), Range("AV:AV"), Range("X:X"), Range("AZ:AZ"), Range("BB:BB"), Range("BD:BD"), Range("BF:BF"), Range("BH:BH"), Range("BJ:BJ"), Range("BL:BL"), Range("BN:BN"), Range("BP:BP"), Range("BR:BR"), Range("BT:BT"), Range("BV:BV"))
'Set RaBereich = Union(Range("CA:CA"), Range("CC:CC"), Range("CE:CE"), Range("CG:CG"), Range("CI:CI"), Range("CK:CK"), Range("CM:CM"), Range("CO:CO"), Range("CQ:CQ"), Range("CS:CS"), Range("CU:CU"), Range("CW:CW"), Range("CY:CY"), Range("DA:DA"), Range("DF:DF"), Range("DH:DH"))
'Set RaBereich = Union(Range("DJ:DJ"), Range("DL:DL"), Range("DN:DN"), Range("DP:DP"), Range("DR:DR"), Range("DT:DT"), Range("DV:DV"), Range("DX:DX"), Range("DZ:DZ"), Range("EB:EB"), Range("ED:ED"), Range("EF:EF"), Range("EH:EH"), Range("EJ:EJ"), Range("EL:EL"), Range("EN:EN"))
'Set RaBereich = Union(Range("EP:EP"), Range("ER:ER"), Range("ET:ET"), Range("EV:EV"), Range("EX:EX"), Range("EZ:EZ"), Range("FB:FB"), Range("FD:FD"), Range("FF:FF"), Range("FH:FH"), Range("FJ:FJ"), Range("FL:FL"), Range("FN:FN"), Range("FP:FP"), Range("FR:FR"), Range("FT:FT"))
'Set RaBereich = Union(Range("FV:FV"), Range("FX:FX"), Range("FZ:FZ"), Range("GB:GB"), Range("GD:GD"), Range("GF:GF"), Range("GH:GH"), Range("GJ:GJ"), Range("GL:GL"), Range("GN:GN"), Range("GP:GP"), Range("GR:GR"), Range("GT:GT"), Range("GV:GV"), Range("GX:GX"), Range("GZ:GZ"))
'Set RaBereich = Union(Range("HB:HB"), Range("HD:HD"), Range("HF:HF"), Range("HH:HH"), Range("HJ:HJ"), Range("HL:HL"), Range("HN:HN"), Range("HP:HP"), Range("HR:HR"), Range("HAT:HAT"), Range("HV:HV"), Range("HX:HX"), Range("HZ:HZ"), Range("IB:IB"), Range("ID:ID"), Range("IF:IF"))
'Set RaBereich = Union(Range("IH:IH"), Range("IJ:IJ"), Range("IL:IL"), Range("IN:IN"), Range("IP:IP"), Range("IR:IR"), Range("IT:IT"), Range("IV:IV"), Range("JA:JA"), Range("JC:JC"), Range("JE:JE"), Range("JG:JG"), Range("JI:JI"), Range("JK:JK"), Range("JM:JM"), Range("JO:JO"))
    
        If Not Intersect(Target, RaBereich) Is Nothing Then
        
               ActiveSheet.Unprotect Password:="skill"
            If IsDate(ActiveCell) Then
                frm_Kalender.Tag = ActiveCell
            ElseIf InStr(ActiveCell, "/") > 0 Then
                DaDatumUe = DateSerial(Mid(ActiveCell, InStr(ActiveCell, "/") + 1), 1, 1) _
                    + Left(ActiveCell, InStr(ActiveCell, "/") - 1) * 7 _
                    - Weekday(DateSerial(Mid(ActiveCell, InStr(ActiveCell, "/") + 1), 1, 1), 2)
                If Weekday(DateSerial(Mid(ActiveCell, InStr(ActiveCell, "/") + 1), 1, 1), 2) > 4 Then
                    DaDatumUe = DaDatumUe + 1
                Else
                    DaDatumUe = DaDatumUe - 6
                End If
                frm_Kalender.Tag = DaDatumUe
            ElseIf ActiveCell = "" Then
                If IsDate(Range("K1")) Then
                    frm_Kalender.Tag = Range("K1")
                Else
                    frm_Kalender.Tag = Date
                  
                End If
            End If
            frm_Kalender.Show
               SendKeys "{ESC}", True
        End If
        Set RaBereich = Nothing
   
    End If
 
    Exit Sub
    'ActiveSheet.Protect Password:="skill"

End Sub