Copier X feuilles sur une feuille

[Nastar]

Salut a tous,

Je souhaite à l'aide d'une macro copier le contenu de plusieurs feuilles sur une feuille, chaque contenu à la suite de l'autre. Sachant que le nom et le nombre des feuilles n'est pas toujours le meme. J'ai essayer la macro suivante mais je n'y arrive pas. Quelqu'un peut-il m'aider?

Sub copy_all_sheets()[/COLOR][/COLOR]Dim Ligne, Nombre As Long
Sheets(1).Range("A1").CurrentRegion.ClearContents
For Nombre = Worksheets.Count To 2 Step -1
Sheets(Nombre).UsedRange

Ligne = Sheets(Nombre).Range("a1") _
.SpecialCells(xlCellTypeLastCell).Row
Sheets(1).Rows("1:" & Ligne).EntireRow.Insert _ shift:=xlDown
Sheets(Nombre).UsedRange.Copy Destination:=Sheets(1).Range("a1")
Application.CutCopyMode = False
Next Nombre

End Sub


Je suis ouvert à toute autre proposition, D'avance merci!🙄

 

[ziopizza]

Re : Copier X feuilles sur une feuille

Bonjour Nastar,
essaye ce code,

Sub copy()
Dim Ligne, Nombre As Long
Application.ScreenUpdating = False
For Nombre = Sheets.Count To 2 Step -1
Ligne = Range("a65536").End(xlUp).Row+1
Sheets(Nombre).Range("A1").CurrentRegion.copy
Sheets(1).Activate
Range("A" & Ligne).Select
ActiveSheet.Paste
Next Nombre
Application.ScreenUpdating = True
End Sub

Salut Yves

 

[Nastar]

Re : Copier X feuilles sur une feuille

Salut Yves,

Merci pour ta solution, la macro fonctionne bien mais malheureusement elle ne copie pas tout le contenu des feuilles. En effet, si dans la colonne A une cellule est vide, la ligne entiere n'est pas copiée bien qu'elle contienne des infos.

Tu vois peut etre comment arranger ça. Merci encore ;-)

 

[ziopizza]

Re : Copier X feuilles sur une feuille

Bonjour Nastar,le Forum

Voila le code transformé,

Private Sub CommandButton1_Click()
Dim Ligne, Nombre As Long
Application.ScreenUpdating = False
For Nombre = Sheets.Count To 2 Step -1
Ligne = Range("a65536").End(xlUp).Row + 1
Sheets(Nombre).Range("a1:" & Sheets(Nombre).Range("a1").SpecialCells(xlCellTypeLastCell).Address).copy
Sheets(1).Activate
Range("A" & Ligne).Select
ActiveSheet.Paste
Next Nombre
Range("a1").Select
End Sub
Bon Dimanche Yves