Recherche dans une liste au fur et à mesure que je tape

Dim a()
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([A2:A16], Target) Is Nothing And Target.Count = 1 Then
    a = Application.Transpose(Sheets("bd").Range("liste"))
    Me.ComboBox1.List = a
    Me.ComboBox1.Height = Target.Height + 3
    Me.ComboBox1.Width = Target.Width
    Me.ComboBox1.Top = Target.Top
    Me.ComboBox1.Left = Target.Left
    Me.ComboBox1 = Target
    Me.ComboBox1.Visible = True
    Me.ComboBox1.Activate
    'Me.ComboBox1.DropDown    ' ouverture automatique au clic dans la cellule (optionel)
  Else
    Me.ComboBox1.Visible = False
  End If
End Sub

Private Sub ComboBox1_Change()
 If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then
   Me.ComboBox1.List = Filter(a, Me.ComboBox1.Text, True, vbTextCompare)
   Me.ComboBox1.DropDown
 End If
   ActiveCell.Value = Me.ComboBox1
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect([g7:g65], Target) Is Nothing And Target.Count = 1 Then
    codes = Split(Target, ":")
    For i = LBound(codes) To UBound(codes)
      nature = Application.VLookup(Val(codes(i)), [codesMip], 2, False)
      If Not IsError(nature) Then
        tmp = tmp & nature & ","
      End If
    Next i
    'Application.EnableEvents = False
    If tmp <> "" Then
      Target.Offset(, 1) = Left(tmp, Len(tmp) - 1)
    Else
      Target.Offset(, 1) = ""
    End If
    'Application.EnableEvents = True
  End If
End Sub

  Function natureEvenement(code)
    codes = Split(code, ":")
    For i = LBound(codes) To UBound(codes)
      nature = Application.VLookup(Val(codes(i)), [codesMip], 2, False)
      If Not IsError(nature) Then
        tmp = tmp & nature & ","
      End If
    Next i
    If tmp <> "" Then
      natureEvenement = Left(tmp, Len(tmp) - 1)
    Else
      natureEvenement = ""
    End If
  End Function