Chercher un mot clé sur toutes les feuilles du classeur

Bonjour,

Je souhaite rechercher un mot clé sur toutes les feuilles d un classeur puis extirper, sur la ligne où le mot a été trouvé, chaque colonne qui m intéresse dans une feuille "Recap"

J 'utilise ce code qui fonctionne trés bien pour une feuille (Merci thev )

Sub DETAILS_GDN()

    Dim sStr As String, cell As Range, cell1 As Range, lignes_à_copier As Range

    sStr = "*KO*"

    Sheets("Recap").Range("A15:G5000").ClearContents

    With Sheets("BRUTE A")

        Set cell = .Range("L2:O3000").Find(sStr)
        If Not cell Is Nothing Then
            Set cell1 = cell
            Do
                If lignes_à_copier Is Nothing Then Set lignes_à_copier = .Columns("I:K").Rows(cell.Row) _
                Else Set lignes_à_copier = Union(lignes_à_copier, .Columns("I:K").Rows(cell.Row))
                Set cell = .Range("L2:O3000").FindNext(cell)
            Loop Until cell.Address = cell1.Address
        End If

    End With

      If Not lignes_à_copier Is Nothing Then lignes_à_copier.Copy: Sheets("Recap").Range("A15").PasteSpecial (xlPasteValues)

End Sub

Pour mon nouveau besoin, j'ai essayé de rajouter une recherche sur toutes les feuilles qui m'intérressent (avec For Each):

Sub DETAILS_GDN()

    Dim sStr As String, cell As Range, cell1 As Range, lignes_à_copier As Range, Ws As Worksheet

    sStr = "*KO*"

    Sheets("Recap").Range("A15:G5000").ClearContents

    For Each Ws In Sheets(Array("BRUTE A", "BRUTE B", "BRUTE C", "BRUTE D"))

        Set cell = .Range("L2:O3000").Find(sStr)
        If Not cell Is Nothing Then
            Set cell1 = cell
            Do
                If lignes_à_copier Is Nothing Then Set lignes_à_copier = .Columns("I:K").Rows(cell.Row) _
                Else Set lignes_à_copier = Union(lignes_à_copier, .Columns("I:K").Rows(cell.Row))
                Set cell = .Range("L2:O3000").FindNext(cell)
            Loop Until cell.Address = cell1.Address
        End If

   Next Ws

      If Not lignes_à_copier Is Nothing Then lignes_à_copier.Copy: Sheets("Recap").Range("A15").PasteSpecial (xlPasteValues)

End Sub

Mais ça ne fonctionne pas !! une idée ?

Bonjour

Avant "SET CELL=" mettre ceci

With WS

Avant NEXT WS mettre ceci

End with

Cordialement

Ya du mieux mais maintenant j ai une erreur:

Erreur d’exécution '1004':

La méthode 'Union' de l'objet '_Global' a échoué

a la ligne :

 Else Set lignes_à_copier = Union(lignes_à_copier, .Columns("I:K").Rows(cell.Row))

Bonjour,

Un fichier ?

Re

J 'utilise ce code qui fonctionne trés bien pour une feuille

Je m'étonne que cela bugue si cela fonctionnait ...

Comme MFerrand, mettez un fichier en ligne

Cordialement

Voici

Ça fonctionne bien pour une feuille mais pas pour plusieurs

Re

J ai l impression que ce code n arrive pas a concaténer la copie de toutes les lignes trouvées sur chacune des feuilles puis de les coller les unes a la suite des autres dans la feuille Recape.

Bonjour,

Une proposition :

Sub Recherche()
    Dim Txt$, ws As Worksheet, i%, n%, Lg%, aa, Tbl()
    Txt = "*KO*"
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Recape"
            Case Else
                aa = ws.Range("A1").CurrentRegion
                For i = 1 To UBound(aa)
                    If aa(i, 3) Like Txt Then
                        ReDim Preserve Tbl(n)
                        Tbl(n) = WorksheetFunction.Index(aa, i, 0)
                        n = n + 1
                    End If
                Next i
        End Select
    Next ws
    With Worksheets("Recape")
        .Range("A1").CurrentRegion.Offset(1).Clear
        If n > 0 Then
            With .Range("A2").Resize(n, 3)
                .Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Tbl))
                .Borders.Weight = xlThin
            End With
        End If
    End With
End Sub

Cordialement.

Super c'est exactement ce que je veux ! Merci.

En revanche après réflexion je souhaiterai améliorer mon tableau en rajoutant des colonnes et ce code ne fonctionne plus et je ne le comprends pas bien 😅

J'enverrai un nouveau fichier a jour des demain matin.

Merci encore pour votre aide

Bonjour,

Voici la mise a jour de mon fichier avec le besoin.

Je n'arrive pas a adapter le code de MFerrand

Notamment: spécifier les colonnes dont j ai besoin de récupérer en feuille "Recape"

Attention le résultat du mot recherché peut être trouvé sur plusieurs colonne source (L,M,N ou O)

Le mot SFP KO est généré par rapport au résultat d une formule (non indiqué dans mon fichier pour des raisons de confidentialité)

C'est pour ca que dans mon code d origine j indique:

 .PasteSpecial (xlPasteValues)

le premier code que je vous ai fourni fais tout nickel excepté qu il ne le fait que sur une seule feuille.

Des que j applique le

for each Ws

ça ne marche plus avec une erreur :

Erreur d’exécution '1004':

La méthode 'Union' de l'objet '_Global' a échoué

Si je pouvais garder ce premier code et debugguer cette erreur ca serait pas mal car je le comprend mieux (donc plus facile a maintenir)

Si vous avez une idée du pourquoi ca deconne....

Ci joint un nouvel exemple a jour (contenant mon code d origine : ORI et celui de MFerrand)

Bonjour,

Pas le temps de regarder ça tout de suite, mais je ne procède jamais (sauf rares exceptions) par copier-coller car ça prend environ 2 à 6 fois plus de temps d'exécution.

Par ailleurs, le code que j'ai fourni procède par récupération des lignes correspondant au critère quel que soit le nombre de colonnes. La seule indication à ajuster éventuellement est :

                  If aa(i, 3) Like Txt Then

si le critère ne se trouve pas en C : il faut alors remplacer le 3 par l'index de colonne de la colonne-critère.

Et lors de l'affectation :

            With .Range("A2").Resize(n, 3)

Il faut remplacer le 3 par UBound(aa, 2) pour que le dimensionnement en nombre de colonnes s'ajuste automatiquement.

Cordialement.

Merci pour votre retour

Mais comment fait on si ce critère ne se trouve pas que sur une colonne mais peut se trouver sur 4 colonnes différentes ? (L,M,N et O)

Dans le même onglet ?

sur toutes les feuilles excepté la feuille Recape

Je ne comprends pas. Dans la feuille Recape, il se trouvera de toutes façons à la position où il était sur la feuille origine... puisque les lignes proviennent de diverses feuilles.

Ma question était de savoir si le critère change de colonne dans les donnnées d'une même feuille. Le fait que la colonne change d'une feuille à l'autre est autre chose. La question porte sur la détection : si dans une feuille donnée le critère sera dans une colonne donnée, on cherche la colonne, puis on teste dans la colonne, ce qui évite de chercher dans 4 ou toutes. On n'aurait alors que la détection de la colonne à faire en plus sur chaque feuille.

Bonjour,

Oui c'est bien ça:

Le critère change de colonne dans les données d'une même feuille (L,M,N ou O)

Je vous joint l exemple.

Si tu changes les paramètres dans lesquels le code doit opérer à chaque fois, si tu ne respectes pas des règles minimales de disposition des données, tu passeras ton temps à réadapter le code.

Sur Recape, la région courante à partir de A15 débutera ligne 12 ! Tant que tu ne vas pas flanquer d'autres mentions ici ou là qui la modifieront. Il faut donc maintenant décaler de 3 pour effacer les données antérieures.

Tu mets en plus des bordures au-delà des données, alors qu'on les supprime pour les réintroduire de façon que la mise en forme suive l'extension des données, mais celles mises en dessous des données ne pourront être effacées, du coup.

Et est-il vraiment nécessaire de flanquer un tableau n'importe où sur la feuille en laissant des lignes vides au-dessus ?

Sur les autres feuilles, la région courante à partir de A1 va s'arrêter colonne G, car H est vide. On va donc devoir considérer la région courante à partir de I1 qui va s'étendre de I à O. Mais dans le tableau résultant, les données de I seront en 1 et celles de O en 7...

Voilà un code adapté à ton fichier... tant que tu ne vas flanquer des machins ici ou là !

Sub Recherche()
    Dim Txt$, TxTest$, ws As Worksheet, i%, j%, n%, Lg%, aa, Tbl()
    Txt = "*SFP KO*"
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Recape"
            Case Else
                aa = ws.Range("I1").CurrentRegion
                For i = 2 To UBound(aa)
                    For j = 4 To 7
                        TxTest = TxTest & aa(i, j)
                    Next j
                    If TxTest Like Txt Then
                        ReDim Preserve Tbl(n)
                        Tbl(n) = WorksheetFunction.Index(aa, i, Array(1, 2, 3))
                        n = n + 1
                    End If
                    TxTest = ""
                Next i
        End Select
    Next ws
    With Worksheets("Recape")
        .Range("A15").CurrentRegion.Offset(3).Clear
        If n > 0 Then
            With .Range("A15").Resize(n, 3)
                .Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Tbl))
                .Resize(, 4).Borders.Weight = xlThin
            End With
        End If
    End With
End Sub

Merci, maintenant que mon tableau est finalisé et mes règles de disposition de données figées ça devrait le faire !!!

Tout fonctionne nickel !

Un grand merci pour ta patience et ton aide !!!!!