XL 2016 Copier Coller à la suite

[coco29]

Bonjour
J'aimerais créer une macro pour copier coller des données de feuilles différentes sur 1 seule feuille commune.

Mon exemple :
PlanningAnnuel: copier coller les données à partir de la ligne 5 jusqu'à X (X étant la ligne où il n'y a plus de données)
PlanningSemestriel: copier coller les données à partir de la ligne 5 jusqu'à X
...
PlanningHebdomadaire...

Et les regrouper à la suite sur PlanningGlobal (feuille commune) en les copiant à partir de la ligne5 à la suite (données PlanningAnnuel puis données PlanningSemestriel ...)

Une idée ?
Est-il possible de l’exécuter sachant que X varie d'une feuille à une autre ?

Voici le fichier :
https://www.cjoint.com/c/IImpDfhLHJl

Option Explicit

Sub compiler()
Dim ligne As Long, ws As Worksheet

Worksheets("PlanningGlobal").Range("A5:XFD1276").ClearContents

    With Worksheets("PlanningGlobal").ListObjects(1)
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
    End With
    ligne = 5
    For Each ws In Worksheets
        If ws.Name Like "PlanningAnnuel" Then
            ws.Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(5, 0).Resize(ws.Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Rows.Count - 1).Copy Destination:=ActiveSheet.Cells(ligne, 1)
            ligne = Cells(Rows.Count, 1).End(xlUp).Row + 1
        End If
          
        If ws.Name Like "PlanningSemestriel" Then
            ws.Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(5, 0).Resize(ws.Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Rows.Count - 1).Copy Destination:=ActiveSheet.Cells(ligne, 1)
            ligne = Cells(Rows.Count, 1).End(xlUp).Row + 1
        End If
        
        If ws.Name Like "PlanningTrimestriel" Then
            ws.Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(5, 0).Resize(ws.Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Rows.Count - 1).Copy Destination:=ActiveSheet.Cells(ligne, 1)
            ligne = Cells(Rows.Count, 1).End(xlUp).Row + 1
        End If
        
        If ws.Name Like "PlanningMensuel" Then
            ws.Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(5, 0).Resize(ws.Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Rows.Count - 1).Copy Destination:=ActiveSheet.Cells(ligne, 1)
            ligne = Cells(Rows.Count, 1).End(xlUp).Row + 1
        End If
        
        If ws.Name Like "PlanningHebdomadaire" Then
            ws.Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(5, 0).Resize(ws.Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Rows.Count - 1).Copy Destination:=ActiveSheet.Cells(ligne, 1)
            ligne = Cells(Rows.Count, 1).End(xlUp).Row + 1
        End If
        
    Next
End Sub

 

[Hasco]

Bonjour,

20 vues et pas une réponse. Certainement que personne (moi le premier) ne veut aller sur ci-joint.
Puisque vous avez excel 2016, pourquoi ne pas utiliser PowerQuery ("Données/Obtenir et Transformer/Nouvelle requête") c'est un outil qui mérite qu'on s'en serve et prenne le temps de l'apprendre.

Cordialement

 

[coco29]

A quoi sert exactement cette manipulation ?
Merci pour votre réponse, je me sens moins seul 🙂