Une macro qui regroupe tous les onglets, quels que soient leurs contenus

Bonjour,

J'ai un besoin un peu particulier. Et je suis débutant absolu.

J'ai un Excel, avec près de 200 onglets, avec des noms d'onglets non structurés.

Chaque Excel contient des infos sur 500 lignes environ, et environ 40 colonnes.

Dans chaque onglet, les données sont structurées avec de légères différences.

Je souhaite une macro qui me permettrait de rapatrier sur UN SEUL onglet tous les infos des AUTRES onglets, en prenant à chaque fois les infos contenues dans les 500 lignes et 40 colonnes.

Est-ce que cela vous parait possible?

Merci d'avance!

bonjour,

oui, tout est possible, mais comment voulez-vous le layout de la feuille de résumé part vue les toutes petites différences des autres feuilles.

Pouvez-vous ajouter un fichier exemplair ?

Hello à tous,

Ce code est une base de travail, s'il y a des particularités il faudra mettre à jour le code.

Il copie toutes les données de toutes les feuilles sauf la première, qui est la feuille de consolidation.

Il faudra adapter peut être la ligne d'en tète et la première colonne de donnée.

Sub RecupData()

    Dim bytLigneEnTete                   As Byte
    Dim bytPremiereColonne               As Byte
    Dim intNbFeuille                     As Integer
    Dim i                                As Integer
    Dim lngDerniereLigne                 As Long

    bytLigneEnTete = 1                  ' Ici indiquer le numéro de la ligne d'en-tete
    bytPremiereColonne = 1              ' Ici indiquer le numéro de la premiere colonne de donnée
    intNbFeuille = Sheets.Count

For i = 2 To intNbFeuille
    If i = 2 Then lngDerniereLigne = bytLigneEnTete Else lngDerniereLigne = (Sheets(1).Cells(Sheets(1).Rows.Count, bytPremiereColonne).End(xlUp).Row) + 1
    With Sheets(i).Cells(bytLigneEnTete, bytPremiereColonne).CurrentRegion
        If i = 2 Then .Copy Sheets(1).Cells(lngDerniereLigne, bytPremiereColonne) Else .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Copy Sheets(1).Cells(lngDerniereLigne, bytPremiereColonne)
        Application.CutCopyMode = False
    End With
Next i

End Sub

Bonjour,

Déjà merci pour vos réponses.

J'ai testé le script écrit, il semble bloquer. C'est peut-être parce que j'ai des cellules fusionnées dans l'Excel (j'avais oublié de le préciser).

J'ai inclus ici un exemple, qui correspond exactement à mon Excel, mis à part le fait que le nombre d'onglets à fusionner est bien plus faible (dans mon vrai Excel, j'ai peut-être 200 onglets).

Merci d'avance pour votre aide, je n'en reviens pas de votre réactivité !

Gilles

bonjour,

Sub Tout()

     Dim shTout
     Set shTout = Sheets("tout")
     shTout.Cells.Clear

     Application.DisplayAlerts = False
     For Each sh In ThisWorkbook.Worksheets     'boucles des feuilles
          If sh.Name <> shTout.Name Then     'sursauter la feuille "Tout"
               Set c = sh.UsedRange     'source
               c.Copy     'copier toutes les cellules utilisées
               With shTout.UsedRange
                    With .Cells(.Rows.Count + 1, 1).Resize(c.Rows.Count, c.Columns.Count)     'destination
                         .PasteSpecial xlAll     'copier tout
                         '.PasteSpecial xlValues
                         .Value = .Value     'eliminer les formules
                    End With
               End With
          End If
     Next
End Sub

C'est absolument parfait.

Vraiment bravo, merci 1000 fois !!!