Code VBA, Extraire les info d'une feuille pour une autre, avec une listbox

Bonjour à tous,

Je sèche un peu sur cette commande, j'ai une facture, je l'enregistre, comptabilise, archive… , tous ça j'ai pu le faire.

Maintenant j'ai un userform de recherche, quand je sélectionne une ligne, j'aimerais que les données ce mette de l'onglet "Consultation", suivant le NumFact.

Est-ce possible? à savoir que ma facture à 63 ligne et 5 colonnes, je vous met mon fichier exemple.

Je vous remercie pour votre retour,

Bonne journée,

RQ

Bonjour

En premier faites les modifications suivantes

Dans le module :
- Supprimez le code Sub Afficher_List()
- Supprimez le Dim i qui se trouve juste en dessous d'Option explicit et mettez-le dans la sub filtrer

Dans l'USF :
- Remplacez la Sub Initialize par celle ci-dessous

Private Sub UserForm_Initialize()
Dim i As Byte
With ListBox1
    .ColumnWidths = "60;80;80;80"
    .ColumnCount = 4
    .List = Range("Tableau1").ListObject.DataBodyRange.Value
End With

With ComboBox1
    For i = 1 To 4
        .AddItem Range("Tableau1").ListObject.HeaderRowRange(i)
    Next i
End With
End Sub

- Ajoutez le code ci-dessous

Private Sub CommandButton1_Click() 'consulter
Dim numfact
Dim lig As Integer
Dim TS As ListObject

If Me.ListBox1.ListIndex = -1 Then Exit Sub
numfact = ListBox1.List(Me.ListBox1.ListIndex, 3)
Set TS = Range("Tableau1").ListObject
With TS
    lig = .DataBodyRange.Find(numfact, LookIn:=xlValues, lookat:=xlWhole).Row - .HeaderRowRange.Row
    With Feuil2
        .Range("C9:D11").ClearContents
        .Range("C6") = numfact
        .Range("C9") = TS.DataBodyRange(lig, 5).Value
        .Range("C10") = TS.DataBodyRange(lig, 6).Value
        .Range("C11") = TS.DataBodyRange(lig, 7).Value
        .Range("D9") = TS.DataBodyRange(lig, 12).Value
        .Range("D10") = TS.DataBodyRange(lig, 13).Value
        .Range("D11") = TS.DataBodyRange(lig, 14).Value
    End With
End With
Unload Me
End Sub

Faites toujours un test comme cela

Crdlt

Edit : tant qu'à faire mettez plutôt les déclarations Dim R(), T As String, CI As Integer dans la sub FiltrerList. Cela n'a aucun intérêt de les mettre en dessous d'Option Explicit puisqu'elles ne concernent que la Sub FiltrerList()

bonjour Rquantin,

un essai, tout fonctionne avec le tableau structuré "tableau1"

EDIT : Salut Dan, un peu plus lent que vous, mais à peu près la même chose, mais je l'avais fait dans le userform ...

Ok super cela fonctionne, je vais essayé de l'adapté dans mon fichier.

Merci beaucoup !

RQ

re,

peut-être trop tard, mais avec le bouton "Consullter" maintenant

Re,

Ok. Merci du retour.

Pensez à cloturer vos fils car je vois dans votre profil que vous ne le faites jamais --> https://forum.excel-pratique.com/membre/23767
Déjà cloturer tous ceux de 2025 serait un plus.

Après petite précision, votre profil mentionne que vous êtes sur MAC. Est-ce que ce projet est destiné à fonctionner sous Excel MAC ou pas ?

Crdlt

Je viens de clôturer les sujet de 2025, désolé, quand on part dans un code, on zappe :-)

Non le projet est pour les ordis tu boulot, tous sous Windows!

Merci encore !

Je reviens vers vous, j'ai un nouveau problème, le code FiltrerList fonctionnait, mais maintenant il me met de erreur, je ne comprend pas pourquoi?

re

Oui j'avais aussi remarqué ce point.

Modifiez comme ceci :
1. Supprimez la Sub FiltrerList qui est dans le module
2. Dans l'USF modifiez :
- Ajoutez ceci en dessous d'Option explicit -->

Option Compare Text

- Ajoutez le code ci-dessous

Sub Filtrerlist()
Dim i As Integer
Dim col As Byte

If ComboBox1.ListIndex = -1 Then Exit Sub
col = ComboBox1.ListIndex
For i = ListBox1.ListCount - 1 To 0 Step -1
    If Not ListBox1.List(i, col) Like "*" & TextBox1 & "*" Then
        ListBox1.RemoveItem (i)
    End If
Next i
End Sub

- Modifiez le code de la textbox1 comme ceci

Private Sub TextBox1_Change()
ListBox1.List = Range("Tableau1").ListObject.DataBodyRange.Value
Call Filtrerlist
End Sub

Dès que vous modifiez la textbox, le code sera exécuté. donc pas besoin d'effacer complétement la textbox

Faites un test
Si ok on peut améliorer un peu pour éviter de répéter certaines lignes dans les codes USF

Re

Une petite amélioration que vous pourriez faire est ceci
- Ajoutez le code ci-dessous

Private Sub ComboBox1_Change()
TextBox1 = vbNullString
End Sub

- Dans le code Private Sub TextBox1_Change(), rajoutez cette ligne juste avant la ligne CALL ....

If TextBox1 = vbNullString Then Exit Sub

Cela videra à chaque fois la textbox sur un changement de la combobox

- Dans la sub initialize, vous pouvez supprimer les lignes with combobox1 ..... end with (donc la boucle qui remplit la combobox1) et remplacer le tout par cette ligne

ComboBox1.List = Application.Transpose(Range("Tableau1").ListObject.HeaderRowRange.Resize(1, 4).Value)

Cordialement