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

Brechet · 17 Septembre 2021

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 !!

sylvanu · 17 Septembre 2021

Bonsoir Brechet, Bruno,
200 onglets dans un fichier ! 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...

Compte Supprimé 979 · 17 Septembre 2021

Bonjour Brechet

C'est simple utilisez l'enregistreur de macro et commencez à faire ce que vous souhaitez pour au moins 2 onglets.

Ensuite il suffira de faire une boucle pour les 200 onglets

@+

sylvanu · 17 Septembre 2021

Bonsoir Brechet, Bruno,
200 onglets dans un fichier ! 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

Brechet · 20 Septembre 2021

Merci beaucoup Sylvanu !!!
C'est super, merci merci.

Oui 200 énorme, je suis d'accord.
La machine génère cela directement.

Bonne semaine

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

Brechet

XLDnaute Nouveau

sylvanu

Compte Supprimé 979

Guest

sylvanu

XLDnaute Barbatruc

Pièces jointes

Brechet

XLDnaute Nouveau

Discussions similaires