Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim L As Worksheet 'déclare la variable L (onglet Liste)
Dim S As Worksheet 'déclare la variable S (onglet Semaine)
Dim TPL(1 To 10) As Range 'déclare la variable TPL (Tableau des PLages)
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim OF As Integer 'déclare la variable OF (OFfset)
Dim TL As Variant 'déclare la variable TL (Tableau de la Liste)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim Lst As String 'déclare la variable Lst (Liste)
On Error GoTo fin 'gestion des erreurs (en cas d'erreur va à l'étiquette "suite")
Set L = Worksheets("Liste") 'définit l'onglet L
TL = L.Range("A2:A" & L.Cells(Application.Rows.Count, "A").End(xlUp).Row) 'définit le tableau de la liste TL
Set S = Worksheets("Semaine") 'définit l'onglet S
'*********************************************************************************************************************
'*définition des plages des demi-journée (comme tu as eu la malheureuse idée de ne pas avoir le même nombre de lignes)
'*********************************************************************************************************************
LI = 4 'initialise la ligne LI
For I = 1 To 10 'boucle sur les 10 demi-journées
Select Case I 'agit en fonction de I
Case 1, 2, 4, 6, 7, 9 'pour ces cas là il y a 8 lignes
OF = 8 'définit l'offset OF
Case 3, 5, 8 'pour ces cas là il y a 9 lignes
OF = 9 'définit l'offset OF
Case 10 'pour ces cas là il y a 10 lignes
OF = 10 'définit l'offset OF
End Select 'fin de l'action en fonction de I
Set TPL(I) = S.Cells(LI, "C").Resize(OF, 7) 'définit la plage TPL(I)
LI = LI + OF + 2 'redéfinit la ligne LI
Next I 'prochaine demi-journée de la boucle
'**************************************************************
'définition de la plage correspondant à la cellule sélectionnée
'**************************************************************
For I = 1 To 10
If Not Application.Intersect(Target, TPL(I)) Is Nothing Then
TV = TPL(I)
Exit For
End If
Next I
'************************************
'définition de la liste de validation
'************************************
For I = 1 To UBound(TL, 1)
For J = 1 To UBound(TV, 1)
For K = 1 To UBound(TV, 2)
If TL(I, 1) = TV(J, K) Then GoTo suite
Next K
Next J
Lst = IIf(Lst = "", TL(I, 1), Lst & "," & TL(I, 1))
suite:
Next I
'***********************************************************
'activation de la liste de validation dans la cellule active
'***********************************************************
With Target.Validation
.Delete
.Add xlValidateList, Formula1:=Lst
End With
fin:
End Sub
