XL 2016 copier coller de plusieurs feuilles selon condition

ced91300 · 10 Avril 2021

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 · 10 Avril 2021

Bonjour @ced91300, le forum

Sans fichier pour tester je te propose :

VB:

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...

Phil69970 · 10 Avril 2021

Bonjour @ced91300, le forum

Sans fichier pour tester je te propose :

VB:

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 · 10 Avril 2021

Phil69970 à dit:
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

XL 2016 copier coller de plusieurs feuilles selon condition

ced91300

XLDnaute Occasionnel

Phil69970

Phil69970

XLDnaute Barbatruc

ced91300

XLDnaute Occasionnel

Discussions similaires

XL 2016 copier coller de plusieurs feuilles selon condition

ced91300

XLDnaute Occasionnel

Phil69970

XLDnaute Barbatruc

ced91300

XLDnaute Occasionnel

​

Discussions similaires