XL 2019 Trier une combobox

Private Sub ComboBox1_GotFocus()
ComboBox1_Change
End Sub

Private Sub ComboBox1_Change()
Dim crit$, tablo, i&, a(), n&
crit = "*" & LCase(ComboBox1) & "*"
tablo = [Tableau1]
For i = 1 To UBound(tablo)
    If LCase(tablo(i, 1)) Like crit Then
        ReDim Preserve a(1, n)
        a(0, n) = tablo(i, 1)
        a(1, n) = tablo(i, 2)
        n = n + 1
    End If
Next
If n Then ComboBox1.List = Application.Transpose(a) Else ComboBox1.Clear
End Sub

Private Sub ComboBox_Produit_Change()
    Dim wb As Workbook, ws As Worksheet, tbl As ListObject
    Dim arr As Variant
    Dim rLo As Long, rHi As Long, cLo As Long
    Dim saisie As String
    Dim i As Long, cnt As Long, idx As Long
    Dim tmp As Variant

    On Error GoTo ErrHandler

    ' Vérif classeur ouvert
    Set wb = Workbooks("Donnees.xlsx")
    Set ws = wb.Worksheets("Liste des produits")
    Set tbl = ws.ListObjects("T_Produits")

    ' charger toutes les données du tableau (DataBodyRange)
    arr = tbl.DataBodyRange.Value

    ' déterminer bornes 
    rLo = LBound(arr, 1): rHi = UBound(arr, 1)
    cLo = LBound(arr, 2) ' colonne 1 du tableau = nom produit ; colonne 2 = prix

    saisie = UCase(Trim(Me.ComboBox_Produit.Text))

    ' 1) compter correspondances
    cnt = 0
    For i = rLo To rHi
        If saisie = "" Or Left$(UCase(CStr(arr(i, cLo))), Len(saisie)) = saisie Then
            cnt = cnt + 1
        End If
    Next i

    ' si rien trouvé => vider et sortir
    If cnt = 0 Then
        Me.ComboBox_Produit.Clear
        Me.TextBox_Prix_Unit = ""
        Exit Sub
    End If

    ' 2) dimensionner un tableau
    ReDim tmp(0 To cnt - 1, 0 To 1) ' 2 colonnes : 0=nom, 1=prix

    ' 3) remplir tmp
    idx = 0
    For i = rLo To rHi
        If saisie = "" Or Left$(UCase(CStr(arr(i, cLo))), Len(saisie)) = saisie Then
            tmp(idx, 0) = CStr(arr(i, cLo))
            tmp(idx, 1) = arr(i, cLo + 1)   ' prix dans la colonne suivante
            idx = idx + 1
        End If
    Next i

    ' 4) affecter à la ComboBox
    With Me.ComboBox_Produit
        .ColumnCount = 2
        .ColumnWidths = "200 pt;0 pt" ' masquer la colonne prix
        .List = tmp
    End With

    '  si saisie est exactement un produit, afficher le prix
    For i = 0 To Me.ComboBox_Produit.ListCount - 1
        If StrComp(Me.ComboBox_Produit.List(i, 0), Me.ComboBox_Produit.Text, vbTextCompare) = 0 Then
            Me.TextBox_Prix_Unit = Format(Me.ComboBox_Produit.List(i, 1), "0.00 €")
            Exit For
        Else
            Me.TextBox_Prix_Unit = ""
        End If
    Next i

    Exit Sub

ErrHandler:
    MsgBox "Erreur " & Err.Number & " : " & Err.Description, vbExclamation
End Sub

Private Sub ComboBox1_GotFocus()
ComboBox1_Change
End Sub

Private Sub ComboBox1_Change()
Dim crit$, tablo, i&, a(), n&, lig&
crit = "*" & LCase(ComboBox1) & "*"
tablo = [Tableau1]
For i = 1 To UBound(tablo)
    If LCase(tablo(i, 1)) Like crit Then
        ReDim Preserve a(1, n)
        a(0, n) = tablo(i, 1)
        a(1, n) = tablo(i, 2)
        n = n + 1
        If n = 1 Then lig = i
    End If
Next
With ComboBox1
    If n = 0 Then .Clear
    If n = 1 Then .List = [Tableau1].Rows(lig).Value
    If n > 1 Then .List = Application.Transpose(a)
End With
End Sub

Private Sub ComboBox1_GotFocus()
ComboBox1_Change
End Sub

Private Sub ComboBox1_Change()
Dim crit$, tablo, i&, a(), n&, lig&
crit = "*" & LCase(ComboBox1) & "*"
tablo = [Tableau1]
For i = 1 To UBound(tablo)
    If LCase(tablo(i, 1)) Like crit Then
        ReDim Preserve a(1, n)
        a(0, n) = tablo(i, 1)
        a(1, n) = tablo(i, 2)
        n = n + 1
        If n = 1 Then lig = i
    End If
Next
With ComboBox1
    .MatchEntry = fmMatchEntryNone
    If n = 0 Then .Clear
    If n = 1 Then .List = [Tableau1].Rows(lig).Value
    If n > 1 Then .List = Application.Transpose(a)
End With
End Sub