1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
   | Option Explicit
 
Private Sub Qui_initiales_Change()
    Qui.Caption = ""
    defaut.Clear
 
    Dim wsTable As Worksheet
    Set wsTable = Worksheets("Tables")
    Dim wsDefaut As Worksheet
    Set wsDefaut = Worksheets("Tables_liste")
    Dim Initiale  As String
    Initiale = Qui_initiales.Value
 
    If Initiale <> "" Then
        Dim InitialLigne As Long
        Dim defaultCol As Long
 
        InitialLigne = wsTable.Range("A2:A" & wsTable.Range("A2").End(xlDown).Row) _
                            .Find(Initiale, LookIn:=xlValues) _
                                .Row
        Qui.Caption = wsTable.Range("B" & InitialLigne).Value
        With wsDefaut
            defaultCol = .Range(.Cells(1, 1), .Cells(1, .Range("A1").End(xlToRight).Column)) _
                            .Find(wsTable.Range("F" & InitialLigne).Value, LookIn:=xlValues) _
                                .Column
            Dim ri As Integer
            For ri = 2 To .Cells(1, defaultCol).End(xlDown).Row
                defaut.AddItem .Cells(ri, defaultCol).Value
            Next ri
        End With
    End If
 
End Sub |