Feuille recherche plusieurs onglets

Bonjour,

Besoin d'aide s.v.p.

J'ai un fichier excel avec plusieurs onglets. Ces onglets représente un inventaire de produit et j'aimerais avoir une feuille de travail pour faire une recherche rapide.

J'aimerais pouvoir entrer une largeur (colonne D de chaque onglet) dans C2 de ma grille de recherche et d'avoir tous les produits avec cette grandeur.

Merci de votre aide.

12inventaire.xlsx (55.74 Ko)

Bonjour,

Une piste en VBA !

Code à mettre dans un module standard :

Sub Recherche()

    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Tbl() As Variant
    Dim Valeur As Variant
    Dim I As Integer
    Dim Adr As String

    'vide la grille et récupère la valeur à rechercher
    With Worksheets("GRILLE DE RECHERCHE")

        Set Plage = .Range(.Cells(7, 2), .Cells(.Rows.Count, 5).End(xlUp))
        If Plage.Cells(1, 1).Address(0, 0) <> "B6" Then Plage.ClearContents

        Valeur = .Range("C2").Value

    End With

    'parcours les feuilles et effectue la recherche, si trouvé, stocke les valeurs dans un tableau
    For Each Fe In Worksheets

        If Fe.Name <> "GRILLE DE RECHERCHE" Then

            With Fe: Set Plage = .Range(.Cells(2, 4), .Cells(.Rows.Count, 4).End(xlUp)): End With
            Set Cel = Plage.Find(Valeur, , xlValues, xlWhole)

            If Not Cel Is Nothing Then

                Adr = Cel.Address

                Do

                    I = I + 1: ReDim Preserve Tbl(1 To 4, 1 To I)
                    Tbl(1, I) = Cel.Offset(, -3).Value
                    Tbl(2, I) = Cel.Offset(, -1).Value
                    Tbl(3, I) = Cel.Value
                    Tbl(4, I) = Cel.Offset(, 1).Value

                    Set Cel = Plage.FindNext(Cel)

                Loop While Cel.Address <> Adr

            End If

        End If

    Next Fe

    'si une valeur au moins a été trouvée colle le résultat dans la grille
    If Not Not Tbl Then

        Worksheets("GRILLE DE RECHERCHE").Cells(7, 2).Resize(UBound(Tbl, 2), UBound(Tbl, 1)).Value = Application.Transpose(Tbl)

    Else

        Worksheets("GRILLE DE RECHERCHE").Cells(7, 2).Value = "Aucune valeur trouvée !"

    End If

End Sub

Il est possible d'attacher le code à un bouton "Formulaire" posé sur la feuille de recherche.

Bonjour,

Une autre proposition à étudier.

Cdlt.

24inventaire.xlsm (108.54 Ko)

Merci beaucoup.

Rechercher des sujets similaires à "feuille recherche onglets"