XL 2016 Copier Coller à la suite

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

coco29

XLDnaute Nouveau
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

VB:
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
 
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
0
Affichages
367
Réponses
1
Affichages
452
Retour