XL 2016 Collage plage provenant de plusieurs onglets dans ordre defini

[davidp]

Bonjour le forum ,

j'ai une nouvelle fois besoin de votre aide et vous remercie par avance pour votre aide.

Je souhaite compiler dans la feuille "COLLAGE1" les données des autres feuilles dans l'ordre suivant :
- à partir de la dernière ligne vide de la colonne A de la feuille "COLLAGE1), insertion de la plage A4: AZ4 jusqu'à dernière ligne pleine de la feuille "COLLAGE2"
puis
- à partir de la dernière ligne vide de la colonne A de la feuille "COLLAGE1), insertion de la plage A4: AZ4 jusqu'à dernière ligne pleine de la feuille "COLLAGE3"
puis
- à partir de la dernière ligne vide de la colonne A de la feuille "COLLAGE1), insertion de la plage A4: AZ4 jusqu'à dernière ligne pleine de la feuille "COLLAGE4"

Merci d'avance

Bonne journée

DAVID

 

[Compte Supprimé 979]

Bonjour DavidP

Voici un code possible

Sub CopierColler()
  Dim ShtD As Worksheet ' Feuille de Destination
  Dim DLigS As Long ' Dernière ligne source
  ' Définir la feuille des destination
  Set ShtD = ThisWorkbook.Sheets("COLLAGE1")
  ' Avec la 1ère feuille à coller
  With Sheets("COLLAGE2")
    DLigS = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A4:AZ" & DLigS).Copy Destination:=ShtD.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
  End With
  ' Avec la 2ème feuille à coller
  With Sheets("COLLAGE3")
    DLigS = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A4:AZ" & DLigS).Copy Destination:=ShtD.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
  End With
  ' Avec la 3ème feuille à coller
  With Sheets("COLLAGE4")
    DLigS = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A4:AZ" & DLigS).Copy Destination:=ShtD.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
  End With
  ' Effacer les variable objet
  Set ShtD = Nothing
End Sub

Après si tes feuilles s'appellent réellement COLLAGE2, 3 et 4 on peut faire une boucle 😉

A+

 

[Staple1600]

Bonsoir

Ok alors je la boucle 😉

Sub CopierCollerEnBouclant()
Dim ws As Worksheet, DLigS As Long
' Définir la feuille des destination
Set ShtD = ThisWorkbook.Sheets("COLLAGE1")
For Each ws In Worksheets
If Right(ws.Name, 1) * 1 > 1 Then
DLigS = ws.Range("A" & Rows.Count).End(xlUp).Row - 3
ws.Range("A4").Resize(DLigS, 52).Copy Destination:=ShtD.Range("A" & Rows.Count).End(3)(2)
Application.CutCopyMode = False
End If
Next
End Sub

 

[davidp]

Bonsoir BrunoM45 et Staple1600

je viens de tester , un grand merci à tous les 2 , les 2 macros fonctionnent à merveille .
Vous allez me faire gagner un temps fou .

Merci encore et à très bientôt sur le forum

Bonne soirée

DAVID