XL 2019 liste deroulante

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, Range("B4:B" & Rows.Count), UsedRange)
If Target Is Nothing Or IsError([Liste]) Then Exit Sub
Dim d As Object, tablo, i&, x$
Set d = CreateObject("Scripting.Dictionary")
tablo = [Liste].Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
    d(CStr(tablo(i, 1))) = ""
Next
For Each Target In Target.Areas 'si entrées ou effacements multiples (copier-coller)
    tablo = Target.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To UBound(tablo)
        x = CStr(tablo(i, 1))
        If x <> "" Then
            If Not d.exists(x) Then
                Application.EnableEvents = False 'désactive les évènements
                Application.Undo 'annule l'entrée
                Application.EnableEvents = True 'réactive les évènements
                Exit Sub
            End If
        End If
Next i, Target
End Sub