Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or Target.Row < 4 Or Target.Column > 1 Then Exit Sub
Target.Select
Target.Validation.Delete 'RAZ
If Target = "" Then Exit Sub
Dim cible$, L%, tablo, i&, x$, n&
cible = LCase(Target)
L = Len(cible)
With Sheets("Base")
.Columns(3).ClearContents
tablo = .Range("A1:B" & .Range("A" & .Rows.Count).End(xlUp).Row) 'matrice, plus rapide, au moins 2 éléments
For i = 2 To UBound(tablo)
x = tablo(i, 1)
If LCase(Left(x, L)) = cible Then
n = n + 1
tablo(n, 1) = x
End If
Next
If n = 0 Then Exit Sub
.[C1].Resize(n).Name = "Liste" 'plage nommée
[Liste] = tablo
[Liste].Sort [Liste], xlAscending, Header:=xlNo 'tri alphabétique
End With
Target.Validation.Add xlValidateList, Formula1:="=Liste"
Target.Validation.ShowError = False
If Application.CountIf([Liste], cible) Then Target.Validation.Delete Else _
CreateObject("WScript.Shell").SendKeys "%{DOWN}" 'supprime la liste ou la déroule
End Sub