Recherche sur toute les feuilles dans une colonne et coller la ligne

Bonjour,

J'ai un classeur contenant plusieurs feuilles. Je tente de faire la recherche dans l'ensemble des feuilles sur la colonne N.

Dès que la recherche trouve une cellule vide en colonne N, il regarde s'il y a une valeur dans la colonne A Si oui, il copie la ligne en entier et la colle dans une nouvelle feuille.

J'ai un début de code qui me donne une erreur. Comme vous le voyez, j'ai besoin d'aide.

Sub liste_()

Application.ScreenUpdating = False

    Dim premiere As Range
    Dim liste As String
    Dim Aucun As String
    Dim Cellule As Range
    Dim ws As Worksheet
    Dim i As Integer
    Dim nwb As Workbook

    liste = "Des éléments ont été trouvés " & Chr(10) & Chr(10) & Chr(10) & _
    "Voulez-vous afficher la liste?"

    Aucun = "Aucun élément de trouvé"

    For Each ws In Worksheets

            Set Cellule = Columns("N:N").Find("", , , , xlByColumns, xlNext).Row
            If Not Cellule Is Nothing Then
                premiere = Cellule.Address
                Do

                    MsgBox liste, vbInformation, "Résultat"

                    'action a faire dès que la ligne est trouvée
                    Set Cellule = Columns("N:N").FindNext(Cellule)
                Loop While Not Cellule Is Nothing And Cellule.Address <> premiere

                Else
             MsgBox Aucun, vbInformation, "Résultat"

              Exit Sub
            End If

    Next
    If MsgBox(liste, vbYesNo, "Résultat") = vbYes Then

            i = 0
    For Each ws In Worksheets

            Set Cellule = Columns("N:N").Find("", , , , xlByColumns, xlNext).Row
            If Not Cellule Is Nothing Then
                premiere = Cellule.Address

                If i = 0 Then Set nwb = Workbooks.Add
            ThisWorkbook.Sheets("Test").Visible = True
            ThisWorkbook.Sheets("Test").Copy Before:=nwb.Sheets(1)
            ThisWorkbook.Sheets("Test").Visible = False
            Application.DisplayAlerts = False
            nwb.Sheets(2).Delete
            Application.DisplayAlerts = True

                Do
                     i = i + 1
                 Worksheets(Cellule.Row).Copy
                 nwb.Sheets("Test").Range("A" & i + 5).PasteSpecial Paste:=xlPasteValues
                    Set Cellule = Columns("N:N").FindNext(Cellule)
                Loop While Not Cellule Is Nothing And Cellule.Address <> premiere

    End If

            Next

        If reponse = vbNo Then
        Exit Sub
        End If

    End If

Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub

Merci de votre aide. Comme d'habitude!!!!

Bonjour,

Dans la ligne set cellule = ..... enlevez l'instruction ROW

Cordialement

Merci l'erreur est maintenant effacée

Par contre, je me retrouve avec un erreur 91 Qui semble se situer

Set Cellule = Columns("N:N").Find("", , , , xlByColumns, xlNext)
            If Not Cellule Is Nothing Then
                premiere = Cellule.Address
                Do

Plus précisément

premiere = Cellule.Address

Merci de votre aide

re

En fait vous cherchez des cellules vides dans la colonne N de toutes vos feuilles et si trouvées, vous affichez un message ?

Vous pouvez expliquer ou mieux placer un fichier représentatif ?

Re

En fait je cherches les cellules vide en N. Si la une cellule est trouvé et que la celle A de la même ligne est non vide = Copier et coller la ligne en entier dans un nouveau classeur (Afin de faire une liste )

Je ne sais pas si je suis assez clair!

Merci

Bonjour

J'ai bizouné mon code. J'obtiens un erreur de type 438 à la ligne

Ws(Cellule.Row).Copy

Voici mon code en entier:

Sub Liste_()

        Dim Ws As Worksheet
        Dim Cellule As Range
        Dim Premiere As Variant
        Dim Réponse As Integer
        Dim i As Integer
        Dim Nwb As Workbook

Réponse = MsgBox("Des éléments ont été trouvés " & Chr(10) & Chr(10) & Chr(10) & _
                "Voulez-vous afficher la liste?", vbYesNo)

        If Réponse = vbYes Then

        For Each Ws In Worksheets 'Pour toute les feuilles du classeur

        Set Cellule = Range("N5:N100").Find("", , , , xlByColumns, xlNext)

        If Not Cellule Is Nothing Then
            Premiere = Cellule.Address

        Do

        'action a faire dès que la ligne est trouvée

        Set Cellule = Range("N5:N100").FindNext(Cellule)
        Loop While Not Cellule Is Nothing And Cellule.Address <> Premiere

            End If

        Next

            i = 0

        For Each Ws In Worksheets

            Set Cellule = Range("N5:N100").Find("", , , , xlByColumns, xlNext)
            If Not Cellule Is Nothing Then
                Premiere = Cellule.Address

                If i = 0 Then Set Nwb = Workbooks.Add
            ThisWorkbook.Sheets("Test").Visible = True
            ThisWorkbook.Sheets("Test").Copy Before:=Nwb.Sheets(1)
            ThisWorkbook.Sheets("Test").Visible = False
            Application.DisplayAlerts = False
            Nwb.Sheets(2).Delete
            Application.DisplayAlerts = True

                Do

                     i = i + 1
                 Ws(Cellule.Row).Copy
                 Nwb.Sheets("Test").Range("A" & i + 5).PasteSpecial Paste:=xlPasteValues
                    Set Cellule = Range("N5:N100").FindNext(Cellule)
                Loop While Not Cellule Is Nothing And Cellule.Address <> Premiere

            End If

            Next

        Else

        Exit Sub

        End If

Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub

Est-ce possible de me donner un coup de main pour régler mon problème.

Merci

Bonjour

Est-ce possible de me donner un coup de main pour régler mon problème.

Oui avec quelques explications
Les lignes de codes qui sont entre If reponse = vbyes et le i =0 , peuvent être supprimées puisqu'elle sont à nouveau reprises plus bas après le i =0

Déjà remplacez la ligne qui vous pose souci par ceci

Ws.Range(Cellule.Address).EntireRow.Copy

Autre question :

Lorsque vous utilisez cette ligne --> Set Cellule = Range("N5:N100").Find("", , , , xlByColumns, xlNext),

- vous êtes sur quelle feuille ? A mon avis sur la feuille WS ?
- ce qui veut dire que vous cherchez les cellules vides dans la colonne N de chacune des feuilles de votre fichier ?

- vous êtes sur quelle feuille ? A mon avis sur la feuille WS ?

Oui sur la Ws.

- ce qui veut dire que vous cherchez les cellules vides dans la colonne N de chacune des feuilles de votre fichier ?

Vous avez vue juste. C'est ce que je cherche à faire.

re

essayez votre code comme ceci :

Sub Liste()
Dim Ws As Worksheet
Dim Cellule As Range
Dim Premiere As Variant
Dim i As Integer
Dim Nwb As Workbook

If MsgBox("Des éléments ont été trouvés " & Chr(10) & Chr(10) & Chr(10) & _
                "Voulez-vous afficher la liste?", vbYesNo, "Afficher les éléments") = vbYes Then

    Application.ScreenUpdating = False
    For Each Ws In Worksheets

        Set Cellule = Ws.Range("N5:N100").Find("", , , , xlByColumns, xlNext)

        If Not Cellule Is Nothing Then
            Premiere = Cellule.Address

            If i = 0 Then Set Nwb = Workbooks.Add

            With ThisWorkbook.Sheets("Test")
                .Visible = True
                .Copy Before:=Nwb.Sheets(1)
                .Visible = False
            End With

            Application.DisplayAlerts = False
            Nwb.Sheets(2).Delete
            Application.DisplayAlerts = True

            Do
                i = i + 1

                Ws.Range(Cellule.Address).EntireRow.Copy
                Nwb.Sheets("Test").Range("A" & i + 5).PasteSpecial Paste:=xlPasteValues

                Set Cellule = Ws.Range("N5:N100").FindNext(Cellule)
            Loop While Not Cellule Is Nothing And Cellule.Address <> Premiere

        End If

    Next Ws

    Application.CutCopyMode = False
End If
Application.ScreenUpdating = True
End Sub

Si ok -->

Cordialement

Merci beaucoup pour votre aide. Tout fonctionne à merveille.