Zwei ursprüngliche Rechtsklickereignisse handhaben

Public Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
If Target.Row > 9 And Target.Row  11 And Target.Column 

Public Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim Spa1&, Spa2&, Zei_Abwesend&, Zei_Vertretung&, Abt_Abwesend, Name_Abw As String,  _
Schicht_Abw
Dim dat_1, dat_2
Dim Zei_List&, Zei_L&, Spa_L&
Dim arrListbox()
'Die folgenden Konstanten müssen ggf. angpasst werden, wenn der Aufbau des Tabellenblattes  _
geändert wird
Const Spa_Farbe = 1     'Spalte mit farbigeb Zellen zu den Namen
Const Spa_Schicht& = 2  'Spalte C - Spalte mit Abteilung
Const Spa_Abt& = 4      'Spalte D - Spalte mit Abteilungen
Const Spa_Name& = 6     'Spalte E - Spalte mit Namen
Const Spa_Datum1& = 12   'Spalte F - 1. Spalte mit einem Kalender-Datum
Const Zei_Name1& = 10    ' 1. Zeile mit einem Namen
Const Zei_Datum& = 9    'Zeile mit Datumswerten
With Target
Zei_L = Cells(Rows.Count, Spa_Name).End(xlUp).Row
Spa_L = Cells(Zei_Datum, Columns.Count).End(xlToLeft).Column
'Prüfung, ob nur Zellen in einer Zeile markiert wurden und 1. Zelle des Bereichs Inhalt  _
hat.
If .Rows.Count = 1 And Target.Cells(1, 1)  "" Then
Select Case .Column
Case Spa_Datum1 To Spa_L
Select Case .Row
Case Zei_Name1 To Zei_L
Cancel = True
Spa1 = .Column
Spa2 = Spa1 + .Columns.Count - 1
Zei_Abwesend = .Row
Abt_Abwesend = Me.Cells(Zei_Abwesend, Spa_Abt).value
Name_Abw = Me.Cells(Zei_Abwesend, Spa_Name).text
Schicht_Abw = Me.Cells(Zei_Abwesend, Spa_Schicht).value
dat_1 = Me.Cells(Zei_Datum, Spa1).value
dat_2 = Me.Cells(Zei_Datum, Spa2).value
ReDim arrListbox(Zei_Name1 To Zei_L, 1 To 4)
Zei_List = LBound(arrListbox, 1)
'im Zeitraum verfügbare Vertreter in Auswahlliste aufnehmen
For Zei_Vertretung = Zei_Name1 To Zei_L
'Prüfen, ob Vertreter im Zeitraum verfühbar
If Application.WorksheetFunction.CountA(Range(Cells( _
Zei_Vertretung, Spa1), _
Cells(Zei_Vertretung, Spa2))) = 0 Then
arrListbox(Zei_List, 1) = Cells(Zei_Vertretung, Spa_Schicht) _
arrListbox(Zei_List, 2) = Cells(Zei_Vertretung, Spa_Abt)
arrListbox(Zei_List, 3) = Cells(Zei_Vertretung, Spa_Name)
arrListbox(Zei_List, 4) = Zei_Vertretung
Zei_List = Zei_List + 1
End If
Next
With UF_Vertretung
.txbAbt = Abt_Abwesend
.txbName = Name_Abw
.txbSchicht = Schicht_Abw
.txbDatum1 = Format(dat_1, "DD.MM.YYYY")
.txbDatum2 = Format(dat_2, "DD.MM.YYYY")
If Zei_List > LBound(arrListbox, 1) Then
.lbxVertretung.List = arrListbox
With .lbxVertretung
'leere Zeilen der Auswahlliste löschen
For Zei_List = .ListCount - 1 To 0 Step -1
If .List(Zei_List, 2) = "" Then
.RemoveItem (Zei_List)
Else
Exit For
End If
Next
End With
End If
.Show
If .Tag = "OK" Then
Zei_Vertretung = Val(.lbxVertretung.value)
'Zellen bei abwesender Person färben
With Range(Cells(Zei_Abwesend, Spa1), Cells(Zei_Abwesend,  _
Spa2))
.Interior.Color = Cells(Zei_Vertretung, Spa_Farbe). _
Interior.Color
End With
'Zellen bei Vertreter färben und Abteilung der vertretenen  _
Person eintragen
With Range(Cells(Zei_Vertretung, Spa1), Cells( _
Zei_Vertretung, Spa2))
.value = Abt_Abwesend
.Interior.Color = Cells(Zei_Vertretung, Spa_Farbe). _
Interior.Color
End With
End If
Unload UF_Vertretung
End With
Case Else
'do nothing
End Select
Case Else
'do nothing
End Select
End If
End With
End Sub