Copier plusieurs feuilles excel en une seule

chtico

XLDnaute Nouveau
Bonjour,

Le problème est le suivant : Comment copier/coller les données de 256 feuilles sur une seule feuille excel
J'ai des données réparties sur 256 feuilles excel. Ces données sont au format texte (avec des cellules vides pour certaines), sur les colonnes A,B,C et sur un maximum de 170 lignes.
Je souhaite les rapatrier les unes en dessous des autres (et ainsi de suite) sur une seule feuille "Récap" de 3 colonnes et donc de 43520 lignes (256 x 170 lignes)
Voici la requête de base pour les 3 premières feuilles :

Sub Macro1()
Sheets("Feuil1").Select
Range("A1:C170").Select
Selection.Copy
Sheets("Récap").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Feuil12").Select
Range("A1:C170").Select
Selection.Copy
Sheets("Récap").Select
Range("A171").Select
ActiveSheet.Paste
Sheets("Feuil13").Select
Range("A1:C170").Select
Selection.Copy
Sheets("Récap").Select
Range("A341").Select
ActiveSheet.Paste
End Sub

Comment faire pour automatiser cette requête pour 256 feuilles ?
Merci de votre aide éclairée.:)
 

mth

XLDnaute Barbatruc
Re : Copier plusieurs feuilles excel en une seule

Bonjour chtico

Un petit essai avec ce code:

Code:
Sub synthese()
Sheets("Recap").Columns("A:C").ClearContents
For i = 1 To Sheets.Count
    If Sheets(i).Name <> "Recap" Then
        Sheets(i).Range("A1:C170").Copy Sheets("Recap").Cells(Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row, 1)
    End If
Next i
End Sub

Bonne journée,

mth
 

mth

XLDnaute Barbatruc
Re : Copier plusieurs feuilles excel en une seule

Bonjour chtico,

Encore moi ....

Il est loin d'être parfait le code que je t'ai donné... Heureusement qu'il y a les amis qui surveillent (ami qui ne veut pas que je le cite mais à qui je dis merci et fais une énooooorme bise :) )

Voici donc le bon code que j'ai eu le plaisir de recevoir en MP pour répondre à ta question, avec

- le ScreenUpdating
- et une bonne gestion des feuilles car, je cite... : "en supprimant ou ajoutant des feuilles la variable "i" ne va pas retrouver ses petits par le code sheets(i)....")

Code:
Sub synthese()
Dim Sh As Worksheet
Application.ScreenUpdating = False
With Sheets("Recap")
    .Columns("A:C").ClearContents
    For Each Sh In Sheets
        If Sh.Name <> .Name Then
            Sh.Range("A1:C170").Copy .Cells(.Rows.Count, 1).End(xlUp)(2)
        End If
    Next Sh
End With
Application.ScreenUpdating = True
End Sub

Voilà chtico, très bonne journée à toi,

[Private] et merci et bisous l'ami du MP ;) [/Private]

mth
 

chtico

XLDnaute Nouveau
Re : Copier plusieurs feuilles excel en une seule

Bonjour mth,

Merci pour ton aide.

Avant ton retour, j'ai pu trouvé une solution "bidouillée" mais qui fonctionne (avec récupération uniquement des lignes dont la valeur en colonne D est égale à 1) :

Private Sub Worksheet_Activate()
[A2:D200].ClearContents
For s = 2 To Sheets.Count
For lig = 2 To Sheets(s).[A65000].End(xlUp).Row
If UCase(Sheets(s).Cells(lig, "D")) = "1" Then
Sheets(s).Cells(lig, 1).Resize(, 5).Copy [A65000].End(xlUp).Offset(1, 1)
[A65000].End(xlUp).Offset(1) = Sheets(s).Name
End If
Next lig
Next s
End Sub

Un grand merci pour tes retours que je m'empresse de tester.
Super réactivité.
Bonne soirée.
Chtico
 

mth

XLDnaute Barbatruc
Re : Copier plusieurs feuilles excel en une seule

Bonsoir chtico :)

Merci pour ton retour, tu nous diras :)

Je profite de ce petit mot pour te demander, quand tu écris du code, utilise la balise de code qui se trouve en haut de la fenêtre de message, celle_ci: #

Ainsi ton code sera bien lisible :)

Merci à toi et à bientôt,

mth
 

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 937
Membres
101 844
dernier inscrit
pktla