placer une interdiction

Private Sub Worksheet_Change(ByVal Target As Range)
Dim L%
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B10:J40")) Is Nothing Then
    L = Target.Row
    Select Case Target
        Case "Lorry", "Bsm", "Vallières", "Patrotte"
            If Application.CountIf(Range("B" & L & ":J" & L), Target) > 1 Then
                Application.Undo
            End If
    End Select
End If
End Sub

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