Const plageB = "B3:B31"
Const PlageListe = "F3:F14"
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim dico, xcell, ycell, n1&, n2&, i
If Intersect(Target, Range(plageB)) Is Nothing Then Exit Sub
n1 = Range(plageB).Row: n2 = n1 + Range(PlageListe).Count - 1
If n2 > Range(plageB).Row + Range(plageB).Rows.Count - 1 Then n2 = Range(plageB).Row + Range(plageB).Rows.Count - 1
Do
Set dico = CreateObject("scripting.dictionary")
For Each ycell In Range(PlageListe): dico(CStr(ycell.Value)) = "": Next ycell
For i = n1 To n2
If dico.exists(CStr(Cells(i, "b"))) Then dico.Remove (CStr(Cells(i, "b")))
Next i
For i = n1 To n2
Cells(i, "b").Validation.Delete
If dico.Count > 0 Then
Cells(i, "b").Validation.Add Type:=xlValidateList, Formula1:=Join(dico.Keys, ",")
End If
Next i
n1 = n1 + Range(PlageListe).Count: n2 = n2 + Range(PlageListe).Count
If n1 > Range(plageB).Row + Range(plageB).Rows.Count - 1 Then Exit Do
If n2 > Range(plageB).Row + Range(plageB).Rows.Count - 1 Then n2 = Range(plageB).Row + Range(plageB).Rows.Count - 1
Loop
End Sub