XL 2013 Liste déroulante comprenant une colonne d'information

Dim f, a(), choix1()
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([C2:C1000], Target) Is Nothing And Target.Count = 1 Then
    Set f = Sheets(1)
    choix1 = f.Range("a2:b" & f.[a65000].End(xlUp).Row).Value
    Tri choix1, 1, LBound(choix1), UBound(choix1)
    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.ListIndex = -1 Then  'And IsError(Application.Match(Me.ComboBox1, Application.Index(choix1, , 1), 0)) Then
     Dim b()
     clé = UCase(Me.ComboBox1) & "*"
     n = 0
     For i = LBound(choix1) To UBound(choix1)
       If UCase(choix1(i, 1)) Like clé Or UCase(choix1(i, 2)) Like clé Then
         n = n + 1: ReDim Preserve b(1 To 2, 1 To n)
         b(1, n) = choix1(i, 1): b(2, n) = choix1(i, 2)
       End If
      Next i
      If n > 0 Then
        ReDim Preserve b(1 To 2, 1 To n)
        Me.ComboBox1.Column = b
      End If
      Me.ComboBox1.DropDown
    Else
       ActiveCell.Value = Me.ComboBox1
    End If
End Sub

Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  choix1 = f.Range("d2:e" & f.[d65000].End(xlUp).Row).Value
  'Tri choix1, 1, LBound(choix1), UBound(choix1)
  Me.ComboBox1.DropDown
End Sub

Private Sub Combobox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = 13 Then ActiveCell = Me.ComboBox1.List(0): ActiveCell.Offset(, 1) = ComboBox1.List(0, 1): Me.ComboBox1.Visible = False
End Sub

Sub Tri(a(), ColTri, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2, ColTri)
  g = gauc: d = droi
  Do
    Do While a(g, ColTri) < ref: g = g + 1: Loop
    Do While ref < a(d, ColTri): d = d - 1: Loop
    If g <= d Then
       For k = LBound(a, 2) To UBound(a, 2)
         temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
       Next k
       g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call Tri(a, ColTri, g, droi)
  If gauc < d Then Call Tri(a, ColTri, gauc, d)
End Sub

Sub AjouteCommentaire()
  Selection.ClearComments
  For Each c In Selection
    c.AddComment CStr(c.Offset(0, 1).Value)
    c.Comment.Shape.TextFrame.AutoSize = True
    c.Comment.Shape.OLEFormat.Object.Font.Size = 8
  Next c
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Column = 3 Then
   Application.EnableEvents = False
   Target.ClearComments
   [listecompte].Find(Target, LookAt:=xlWhole).Copy
   Target.PasteSpecial Paste:=xlPasteComments
   Application.EnableEvents = True
  End If
End Sub