liste déroulante, saisie semi-automatique

Dim Choix1()
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([B13:B73], Target) Is Nothing And Target.Count = 1 Then
    Set f = Sheets("parametres")
    Set Rng = f.Range("M2:M" & f.[M65000].End(xlUp).Row)
    Choix1 = Application.Transpose(Rng)
    Me.ComboBox1.List = Choix1
    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
  Else
    Me.ComboBox1.Visible = False
  End If
End Sub

Private Sub ComboBox1_Change()
If Me.ComboBox1 <> "" Then
     mots = Split(Trim(Me.ComboBox1), " ")
     Tbl = Choix1
     For i = LBound(mots) To UBound(mots)
       Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
     Next i
     Me.ComboBox1.List = Tbl
     Me.ComboBox1.DropDown
End If
End Sub

Private Sub ComboBox1_click()
   ActiveCell.Value = Me.ComboBox1
End Sub