Listbox avec recherche

Bonjour,

Je bloque sur ma macro.

Je souhaite liste toute les références identiques de plusieurs pages dans une listbox.

J'ai réussi a le faire pour une page, mais quand je veux le faire pour plusieurs pages, j'ai un message d'erreur.

Si quelqu'un peut m'aider cela serait super.

L'userform est le Résultat, les 2 autres seront pour une amélioration future

Merci

Bonjour,

Un essai ...

Private Sub UserForm_Initialize()
Dim Trou As Range
Dim last As Long

Resul.ColumnHeads = True
Resul.ColumnCount = 5

For j = 1 To Worksheets.Count
    Nomfeuille = Worksheets(j).Name
    With Worksheets(j)

        last = .Range("A" & Rows.Count).End(xlUp).Row
        Set Trou = .Range("A1:A" & last).Find("4529", LookIn:=xlValues)

        If Not Trou Is Nothing Then
            Resul.AddItem .Cells(Trou.Row, 1)
            Resul.List(Resul.ListCount - 1, 1) = .Cells(Trou.Row, 4)
            Resul.List(Resul.ListCount - 1, 2) = .Cells(Trou.Row, 6)
            Resul.List(Resul.ListCount - 1, 3) = .Cells(Trou.Row, 7)
            Resul.List(Resul.ListCount - 1, 4) = Nomfeuille
        End If
    End With
Next j
End Sub

ric

Bonjour,

J'ai commis une erreur dans le code précédent > il ne trouve qu'une ligne par feuille > s'il y a plusieurs numéros d'items identiques (colonneA) dans une feuille > un bout de code sera à ajouter ...

J'attends ton avis ...

ric

ric a écrit :

Bonjour,

J'ai commis une erreur dans le code précédent > il ne trouve qu'une ligne par feuille > s'il y a plusieurs numéros d'items identiques (colonneA) dans une feuille > un bout de code sera à ajouter ...

J'attends ton avis ...

ric

Merci, ça fonctionne nickel et effectivement il pourrait y avoir plusieurs items identiques

Bonsoir ric, Damsa17

Veuillez trouver une version :

Le principe de la recherche ici est "contient" et il y a une input box pour renseigner ce qu'il faut chercher.

@ bientôt

LouReeD

Bonjour à tous,

Un essai > trouve les numéros (chiffres) même s'il y en a plusieurs dans une feuille ...

Private Sub UserForm_Initialize()
Dim Trou As Range
Dim last As Long
Dim Jecherche As Integer, J As Integer
Dim FirstAddress As String
Dim NomFeuille As String

    Resul.ColumnHeads = True
    Resul.ColumnCount = 5

    Jecherche = 4529

    For J = 1 To Worksheets.Count
        NomFeuille = Worksheets(J).Name
        With Worksheets(J)

            last = .Range("A" & Rows.Count).End(xlUp).Row
            Set Trou = .Range("A1:A" & last).Find(Jecherche, LookIn:=xlValues)

            If Not Trou Is Nothing Then
                FirstAddress = Trou.Address
                Resul.AddItem .Cells(Trou.Row, 1)
                Resul.List(Resul.ListCount - 1, 1) = .Cells(Trou.Row, 4)
                Resul.List(Resul.ListCount - 1, 2) = .Cells(Trou.Row, 6)
                Resul.List(Resul.ListCount - 1, 3) = .Cells(Trou.Row, 7)
                Resul.List(Resul.ListCount - 1, 4) = NomFeuille

                Do
                    'mark the cell in the column to the right if "Ron" is found
                    Set Trou = .Range("A1:A" & last).FindNext(Trou)
                    If Trou.Address <> FirstAddress Then
                        Resul.AddItem .Cells(Trou.Row, 1)
                        Resul.List(Resul.ListCount - 1, 1) = .Cells(Trou.Row, 4)
                        Resul.List(Resul.ListCount - 1, 2) = .Cells(Trou.Row, 6)
                        Resul.List(Resul.ListCount - 1, 3) = .Cells(Trou.Row, 7)
                        Resul.List(Resul.ListCount - 1, 4) = NomFeuille
                    End If
                Loop While Not Trou Is Nothing And Trou.Address <> FirstAddress
            End If
        End With
    Next J
End Sub

ric

Merci Ric...

C'est Nickel

Loureed, je vais essayer ton fichier.

Mais merci de vos réactions rapide