Microsoft 365 Excel/VBA : copier plusieurs feuilles dans une seule

[dreamy]

Bonjour à tous,

Je souhaiterais avoir votre aide pour améliorer un fichier que j'utilise et l'automatiser pour une tache.
J'ai un fichier avec 16 feuilles dont 12 pour chaque mois de l'année. Je voudrais copier automatiquement toutes les lignes des feuilles de l'année (Jan, Fév, etc...) uniquement dans une seule feuille Compta 1.
Chaque mois je rajoute les lignes en questions donc les lignes doivent s'ajouter à la suite dans la dernière ligne vide de ma feuille Compta 1.
Je dois copier les lignes à partir de la ligne A4 jusqu'a la dernière ligne remplie et jusqu'a la colonne N (il y a d'autres colonnes après mais ne doivent pas être copiées).

J'ai trouvé des macros sur le forum qui ressemble à ma recherche, mais je n'arrive pas à l'adapter par manque de connaissances je pense... (soit ça me prend toutes les pages, soit ça ne se colle pas correctement..)

Si quelqu'un a un peu de temps pour m'aider, je l'en remercie par avance,
Je mets un fichier test pour visualiser (j'ai mis des données seulement dans les feuilles Jan et Fév)

Belle journée à tous,

 

[sylvanu]

Bonjour Dreamy,
Un essai en PJ. La macro s'active quand on sélectionne la "feuille compta 1".

Sub Worksheet_Activate()
    Dim DL%, Mois(), N%, DLcompta%, NbLignes%
    DL = Range("B65500").End(xlUp).Row
    If DL > 1 Then Range("A2:O" & DL).ClearContents ' On efface le tableau
    Application.ScreenUpdating = False
    ' On passe par un array pour être sur d'avoir la liste par ordre chronologique
    Mois = Array("Jan", "Fév", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Sept", "Oct", "Nov", "Déc")
    For N = 0 To 11
        With Sheets(Mois(N))
            DL = .Range("A65500").End(xlUp).Row
            If DL > 3 Then ' Car liste commence en 4
                DLcompta = Range("B65500").End(xlUp).Row: NbLignes = DL - 3
                Range("B" & DLcompta + 1 & ":O" & DLcompta + NbLignes) = .Range("A4:N" & DL).Value  ' Copier Coller valeurs
            End If
        End With
    Next N
    ' Transfert du N° de facture de la colo O à la col A
    DL = Range("B65500").End(xlUp).Row: Range("A2:A" & DL) = Range("O2:O" & DL).Value
    [O:O].ClearContents
    Application.ScreenUpdating = True
End Sub

 

[dreamy]

Bonjour Sylvanu,

Un immense merci !!! Ça fonctionne parfaitement et les autres macros qui fonctionnaient à partir de ma feuille compta s'active toujours.
J'ai eu au début un message d'erreur sur mon fichier arrivé à la page AVRIL il bloquait, mais j'avais des espaces sur certains noms de feuilles... une fois enlever c'est parfait !

Encore merci pour votre rapidité et votre aide !!! et un autre merci pour les explications noter dans la macro, ça m'aide à comprendre votre code et mes erreurs sur mes tentatives ...

Très belle journée à vous !

​

 

[sylvanu]

Bonjour,

mais j'avais des espaces sur certains noms de feuilles...

Exact, j'ai omis de vous le dire.
Je les avais supprimé sur ma PJ.