Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cellule As Range
Dim coll As New Collection
Dim i As Long
Dim data1 As Variant
' on remplit une collection
If Target.Count > 1 Then Exit Sub
' pour sortir si la cellule n'est pas dans la plage
If Intersect(Target, Range("B10:J40")) Is Nothing Then Exit Sub
For Each cellule In Worksheets("Infos").Range("l1:l20")
If cellule <> "" Then coll.Add cellule, CStr(cellule)
Next cellule
' on supprime les sites présent dans la collection si les sites sont dans la ligne sélectionnée
With Worksheets(Target.Worksheet.Name)
For Each cellule In .Range("b" & Target.Row & ":j" & Target.Row)
Select Case cellule
Case "Lorry", "Bsm", "Vallières", "Patrotte"
On Error GoTo suite1
coll.Add cellule, CStr(cellule)
End Select
Next cellule
'Application.ScreenUpdating = True
'End If
'flag = False
End With
For i = 1 To coll.Count
If coll(i) <> "" Then
If i = 1 Then
data1 = coll(i)
Else
data1 = data1 & "," & coll(i)
End If
End If
Next i
valid Target, data1
Exit Sub
suite1:
coll.Remove cellule
Resume Next
End Sub
Sub valid(cellule As Range, data1 As Variant)
With cellule.Validation
.Delete
.Add xlValidateList, xlValidAlertStop, xlBetween, data1
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub