Macro copier coller lignes plusieurs feuilles dans une

Bonjour,

Je dois réaliser un Macro qui je pense est assez compliqué, je tiens à préciser que je suis novice.

Je vous explique ce que doit faire la macro.

Dans mon classeur Excel j’ai plusieurs feuilles

La macro doit parcourir l’ensemble de feuilles (sauf la première feuille de destination) et copier des toutes lignes non vides des feuilles a partir de la ligne 6 qui ont une valeur en colonne 1 dans la feuille de destination (ici Synthèse).

Vous trouvez ci-joint le classeur Excel.

Si quelqu’un peut m’aider à coder ceci et m'expliquer sa démarche car je suis complètement perdu,

Merci d'avance

Bonjour,

Voici un exemple de code à tester :

Sub copieFeuilDansSynthese()

' Boucle sur chaque Feuille (Sauf la première qui est Synthese)
For i = 2 To Sheets.Count

    Sheets(i).AutoFilterMode = False ' Suppression de tyout Filtre
    Sheets(i).Rows("5:5").AutoFilter Field:=1, Criteria1:="<>" ' Filtre sur la première colonne différent de vide
    Sheets(i).Rows("6:" & Sheets(i).Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy 'Copie

    LigneCollage = Sheets("Synthese").Range("A" & Rows.Count).End(xlUp).Row + 1 'Rechercher de la ligne de collage
    If LigneCollage < 6 Then LigneCollage = 6

    Sheets("Synthese").Range("A" & LigneCollage).PasteSpecial 'Collage
    Application.CutCopyMode = False
    Sheets(i).AutoFilterMode = False ' Suppression de tout Filtre

Next i

End Sub

Dis moi si ça te convient ou si tu as des questions !

RemBabar

Bonjour,

Avec un bouton de commande dans l'onglet "Synthèse" lié à ce code suivant peut faire l'affaire :

Sub Bouton1_Cliquer()
    derLigDest = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
    If derLigDest > 5 Then Range("6:" & derLigDest).Delete
    For Each sh In ActiveWorkbook.Worksheets
        derLigDest = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row + 1
        If sh.Name <> ActiveSheet.Name Then
            derLigSource = sh.Range("B" & Rows.Count).End(xlUp).Row
            sh.Range("A6:S" & derLigSource).Copy Destination:=ActiveSheet.Range("A" & derLigDest)
        End If
    Next sh
End Sub

Bonjour,

Autre méthode :

Sub Synthèse()
    Dim ns%, n%, i%, ws As Worksheet, wsSyn As Worksheet
    Set wsSyn = Worksheets("Synthese")
    With wsSyn
        ns = .Range("A6").SpecialCells(xlCellTypeLastCell).Row
        .Range("A6:S" & ns).ClearContents: ns = 6
    End With
    Application.ScreenUpdating = False
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Synthese"
            Case Else
                With ws
                    n = .Cells(.Rows.Count, 1).End(xlUp).Row
                    If n >= 6 Then
                        .Range("A6:S" & n).Sort key1:=.Cells(6, 1), order1:=xlAscending, Header:=xlNo
                        n = .Cells(.Rows.Count, 1).End(xlUp).Row
                        wsSyn.Cells(ns, 1).Resize(n - 5, 19).Value = .Range("A6:S" & n).Value
                        ns = ns + n - 5
                    End If
                End With
        End Select
    Next ws
End Sub

Cordialement.

Bonjour,

j'ai testé la première solution est elle fonctionne très bien.

Merci a tous pour vos retours

Cordialement,