XL 2013 Regrouper une sélection de cellules de plusieurs onglets sur un seul

Brechet

XLDnaute Nouveau
Bonjour

J'ai un fichier Excel avec près de 200 onglets.
Je cherche a copier coller les cellules de la plage E1:N100 de chacun des 200 onglets pour les coller les uns à la suite des autres sur un seul onglet.

Pouvez vous aider avec un code VBA SVP ?
Je vous remercie beaucoup pas avance !!
 
Solution
Bonsoir Brechet, Bruno,
200 onglets dans un fichier ! :eek: Attention à la taille du fichier total. :)

Un essai en PJ. J'ai appelé "Tout" la feuille qui consolide, avec
VB:
Sub Consolider()
    Application.ScreenUpdating = False
    Cells.ClearContents                             ' Effacement feuille
    For Each Feuille In Worksheets                  ' Pour toutes les feuilles
        If Feuille.Name <> "Tout" Then              ' "Tout" est la feuille de consolidation, à modifier.
            DL = Range("A1000000").End(xlUp).Row    ' Première ligne libre
            Range("A" & DL + 1 & ":J" & DL + 100) = Sheets(Feuille.Name).Range("E1:N100").Value ' Copier Coller valeurs
        End If
    Next Feuille
    [A1:J1].Delete Shift:=xlUp...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Brechet, Bruno,
200 onglets dans un fichier ! :eek: Attention à la taille du fichier total. :)

Un essai en PJ. J'ai appelé "Tout" la feuille qui consolide, avec
VB:
Sub Consolider()
    Application.ScreenUpdating = False
    Cells.ClearContents                             ' Effacement feuille
    For Each Feuille In Worksheets                  ' Pour toutes les feuilles
        If Feuille.Name <> "Tout" Then              ' "Tout" est la feuille de consolidation, à modifier.
            DL = Range("A1000000").End(xlUp).Row    ' Première ligne libre
            Range("A" & DL + 1 & ":J" & DL + 100) = Sheets(Feuille.Name).Range("E1:N100").Value ' Copier Coller valeurs
        End If
    Next Feuille
    [A1:J1].Delete Shift:=xlUp                      ' Suppression première ligne
    Columns.AutoFit                                 'Ajustement largeurs colonnes
    [A1].Select
    Application.ScreenUpdating = True
End Sub
 

Pièces jointes

  • Brechet.xlsm
    78.1 KB · Affichages: 6

Discussions similaires

Réponses
16
Affichages
615

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 104
dernier inscrit
JEMADA