XL 2013 Faire une recherche dans un tableau

Option Explicit

Dim f As Worksheet, a()

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim mémo$, n&
  With Target
    If .CountLarge > 1 Or .Address(0, 0) <> "C6" Then ComboBox1.Visible = 0: Exit Sub
    If mémo <> "" Then If IsError(Application.Match(Range(mémo), a, 0)) Then Range(mémo) = ""
    Set f = Worksheets("Liste_défauts"): n = f.Cells(Rows.Count, 1).End(3).Row
    Do While f.Cells(n, 1) = "": n = n - 1: Loop: a = Application.Transpose(f.[A2].Resize(n - 1))
    ComboBox1.List = a: ComboBox1.Height = .Height + 3: ComboBox1.Width = .Width
    ComboBox1.Top = .Top: ComboBox1.Left = .Left: ComboBox1 = .Value
    ComboBox1.Visible = -1: ComboBox1.Activate: mémo = .Address
  End With
End Sub

Private Sub ComboBox1_Change()
  Dim d1 As Object, tmp$, c, n As Byte, v As Byte, col%, lg1&, lg2&
  If ComboBox1 <> "" And IsError(Application.Match(ComboBox1, a, 0)) Then
    Set d1 = CreateObject("Scripting.Dictionary"): tmp = UCase$(ComboBox1) & "*"
    For Each c In a
      If UCase$(c) Like tmp Then d1(c) = ""
    Next c
    ComboBox1.List = d1.keys: ComboBox1.DropDown
  End If
  [C6] = ComboBox1: col = ComboBox1.ListIndex + 1: If col = 0 Then Exit Sub
  Application.ScreenUpdating = 0: [C8].Resize(7).ClearContents: lg2 = 8
  With Worksheets("REMEDES")
    n = .Cells(42, col): If n = 0 Then Exit Sub
    For lg1 = 4 To 41
      v = Val(.Cells(lg1, col))
      If v > 0 Then
        Cells(lg2, 3) = .Cells(lg1, "BA"): lg2 = lg2 + 1
        n = n - 1: If n = 0 Then Exit For
      End If
    Next lg1
  End With
End Sub

Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim n&: n = f.Cells(Rows.Count, 1).End(3).Row: Do While f.Cells(n, 1) = "": n = n - 1: Loop
  ComboBox1.List = Application.Transpose(f.[A2].Resize(n - 1)): ComboBox1.DropDown
End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode <> 13 Then Exit Sub
  If IsError(Application.Match(ActiveCell, a, 0)) Then ActiveCell = ""
  [C7].Select
End Sub