XL 2016 copier coller de plusieurs feuilles selon condition

[ced91300]

Bonjour à tous,

j'ai un bva copier/coller dans une autre feuille sous condition qui fait parfaitement le Job.
je souhaiterai l'adapter afin qu'il le fasse mais en prenant les données sur plusieurs feuilles (données disposées à l'identiques)
Merci
Cordialement.

Sub Bouton1_Cliquer()
Dim i As Long
Dim derlig As Long
Application.ScreenUpdating = False
'****************************** nétoyer feuille qui recevera les données
With Sheets("LULU")
.Cells.ClearContents
End With
'copier

Dim k As Integer
k = 2
With Sheets("bernard")
derlig = .Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To derlig
If .Cells(i, 8) = "X" Then 'ici si la cellule i de la colonne A est différent de vide alors copier
.Cells(i, 1).EntireRow.Copy
Sheets("LULU").Activate
Sheets("LULU").Range("A" & k).Select
ActiveSheet.Paste
k = k + 1
End If
Next i

End With
Sheets("LULU").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

 

[Phil69970]

Bonjour @ced91300, le forum

Sans fichier pour tester je te propose :

Option Explicit
Option Compare Text

Sub Bouton1_Cliquer()

Dim NbLig&, DLDest&, i&
Dim Ws As Worksheet
Application.ScreenUpdating = False

For Each Ws In Worksheets
    If Ws.Name <> "LULU" Then
        NbLig = Ws.Cells(Columns(1).Cells.Count, 8).End(xlUp).Row
        For i = 2 To NbLig
            If Ws.Range("H" & i).Value = "x" Then
                DLDest = Worksheets("LULU").Cells(Columns(1).Cells.Count, 8).End(xlUp).Row + 1
                Ws.Cells(i, 8).EntireRow.Copy
                Sheets("LULU").Range("A" & DLDest).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End If
        Next
    End If
Next
    
Application.CutCopyMode = False

End Sub

Merci de ton retour
*Si cela ne fonctionne pas un fichier serait le bienvenu....

@Phil69970

 

[ced91300]

Bonjour @ced91300, le forum

Sans fichier pour tester je te propose :

Next
End If
Next

Application.CutCopyMode = False

End Sub
[/CODE]

Merci de ton retour
*Si cela ne fonctionne pas un fichier serait le bienvenu....

@Phil69970

​

bonjour merci pour ta solution, c'est parfait.
Cordialement
Cédric