Liste déroulante intélligente

Dim a()

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
  If Not Intersect([A2:A16], Target) Is Nothing And Target.Count = 1 Then
    With Worksheets("Feuil3")
        derlig = .Range("C" & Rows.Count).End(xlUp).Row
        a = Application.Transpose(.Range("C1:C" & derlig))
    End With
    With Me.ComboBox21
        .List = a
        .Height = Target.Height + 3
        .Width = Target.Width
        .Top = Target.Top
        .Left = Target.Left
        .Visible = True
        .Activate
    End With
    Me.ComboBox21 = Target
    'Me.ComboBox1.DropDown ' ouverture automatique au clic dans la cellule
  Else
    Me.ComboBox21.Visible = False
  End If
End Sub

Private Sub ComboBox21_Change()
    If Me.ComboBox21 <> "" And IsError(Application.Match(Me.ComboBox21, a, 0)) Then
        Set d1 = CreateObject("Scripting.Dictionary")
        tmp = UCase(Me.ComboBox21) & "*"
        tmp1 = "* " & UCase(Me.ComboBox21) & "*"
        For Each c In a
            If UCase(c) Like tmp Or UCase(c) Like tmp1 Then
                d1(c) = ""
            End If
        Next c
        Me.ComboBox21.List = d1.keys
        Me.ComboBox21.DropDown
    End If
  ActiveCell.Value = Me.ComboBox21
End Sub

Private Sub ComboBox21_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    With Worksheets("Feuil3")
        derlig = .Range("C" & Rows.Count).End(xlUp).Row
        ComboBox21.List = .Range("C1:C" & derlig).Value
    End With
  Me.ComboBox21.DropDown
End Sub

Private Sub ComboBox21_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = 13 Then ActiveCell.Offset(1).Select
End Sub