Regrouper données plusieurs feuilles dans une seule feuille

Version imprimable

Bonjour à tous,

Je travaille sur une macro me permettant de regrouper toutes les données de plusieurs feuilles dans une seule feuille (toutes les feuilles en question se trouvant dans le même fichier Excel), avec quelques détails d'affichage du résultat. Voici toutes les étapes dont j'ai besoin :

1. Regrouper toutes les données des feuilles du fichier dans une seule feuille "Liste"
2. Mise en forme : supprimer les lignes vides qui ont pu être collées dans la feuille "Liste", et supprimer la mise en forme des bordures de tableau
3. Tri sur la colonne "C" qui contient des dates, de la plus ancienne à la plus récente
4. Compter le nombre de lignes de la feuille "Liste" pour afficher le nombre total dans une cellule

Et il faudrait que tout ce listing soit remplacé par le nouveau à chaque activation de la macro.

J'ai déjà un gros pavé de code, qui est le résultat d'un regroupement de plusieurs macros trouvées ici et là sur le web :roll: :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 Sub Liste_Résultats() Dim dlgR As Integer, dlgi As Integer Dim i As Byte 'Sélectionne la feuille récapitulative et supprime les résultats précédents Sheets("Liste").Activate Range("A:D").Cells.Clear 'Liste les données de toutes les autres feuilles dans la feuille "Liste" For i = 1 To Worksheets.Count If UCase(Sheets(i).Name) <> "Liste" Then dlgR = Sheets("Liste").Range("A" & Rows.Count).End(xlUp).Row With Sheets(i) dlgi = .Range("A" & Rows.Count).End(xlUp).Row .Range("A2:D" & dlgi).Copy Sheets("Liste").Range("A" & dlgR + 1) End With End If Next 'Supprime les éventuelles lignes vides Range("A1:A65536").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'Supprime les bordures de tableau Cells.Select With Selection .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone .Interior.ColorIndex = xlNone End With 'Tri par date, de la plus ancienne à la plus récente Columns("C:C").Select ActiveWorkbook.Worksheets("Liste").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Liste").Sort.SortFields.Add Key:=Range("C1"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Liste").Sort .SetRange Range("A1:D65536") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ActiveWindow.SmallScroll Down:=-15 'Compte le nombre de lignes pour inscrire le résultat Dim NbLig As Integer NbLig = Cells.SpecialCells(xlCellTypeLastCell).Row Worksheets("Liste").Range("K:K").Cells.Clear Worksheets("Liste").Range("K5").Value = "Total : " & NbLig End Sub
Problème : tout fonctionne, sauf que les résultats des différentes feuilles apparaissent plusieurs fois dans la feuille "Liste", ce qui devraient évidemment ne pas être le cas.

Si quelqu'un a le courage de se pencher sur mon patchwork de code... Merci beaucoup d'avance ! :D

07/11/2017, 15h26
Menhir

Citation:

Envoyé par Ysae68

J'ai déjà un gros pavé de code, qui est le résultat d'un regroupement de plusieurs macros trouvées ici et là sur le web :roll: :

Mauvaise idée.

Citation:

les résultats des différentes feuilles apparaissent plusieurs fois dans la feuille "Liste", ce qui devraient évidemment ne pas être le cas.

Je ne comprends pas.
Est-ce que tu veux dire que le traitement précédent n'est pas supprimé avec que les nouvelles données soient implantées ?

Si c'est le cas, essaye de remplacer Range("A:D").Cells.Clear par UsedRange.EntireRow.Delete.

Citation:

Code:

Range("A1:A65536").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Ca ce n'est pas une très bonne idée.
Si tes données ne font que quelques centaines de ligne, ton code se paye le Delete de 65 000 lignes pour rien.
Si, à l'opposé, tes données font plus de 66000 lignes (ce qui est possible avec les versions d'Excel qui ne sont pas antédiluviennes), une partie ne sera pas effacée.

Il vaudrait mieux écrire quelque chose comme :

Code:

Range("A1", Cells(Rows.Count, 1).End(xlup)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Ou bien

Code:

Intersection(UsedRange, Columns(1)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
08/11/2017, 09h14
Ysae68

Merci pour la réponse :)

Citation:

Envoyé par Menhir

Mauvaise idée.

Ah mais je m'en doute, simplement ne sachant écrire du VBA en partant de 0, je bricole avec ce que je trouve :aie:

Citation:

Envoyé par Menhir

Est-ce que tu veux dire que le traitement précédent n'est pas supprimé avec que les nouvelles données soient implantées ?

Les résultats précédents sont bien effacés à chaque lancement de la macro, et ensuite les données des différentes feuilles sont listées deux fois dans la feuille récapitulative lors de l'exécution du script (alors qu'évidemment ils ne devraient l'être qu'une seule fois).

Citation:

Envoyé par Menhir

Si tes données ne font que quelques centaines de ligne, ton code se paye le Delete de 65 000 lignes pour rien.

A peine environ une centaine de lignes au total, mais comme les données des différentes feuilles changent régulièrement, j'aimerai éviter de devoir les copier/coller manuellement dans la feuille récapitulative à chaque fois...
08/11/2017, 09h39
Marc-L

Bonjour !

Citation:

Envoyé par Ysae68

Regrouper données plusieurs feuilles dans une seule feuille

Voir déjà la contribution du même nom dans le sous-forum d'Excel Contribuez !

___________________________________________________________________________________________________________
Je suis Paris, New-York, Mogadicio, Barcelone, London, Manchester, Egypte, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …
08/11/2017, 10h09
Menhir

Citation:

Envoyé par Ysae68

ne sachant écrire du VBA en partant de 0, je bricole avec ce que je trouve :aie:

Comme le côté obscure de la Force, c'est un chemin plus rapide et plus séduisant.
Une solution plus efficace à moyen terme serait d'acquérir un minimum de connaissances de base en se formant.
http://bidou.developpez.com/article/VBA/

Citation:

Les résultats précédents sont bien effacés à chaque lancement de la macro, et ensuite les données des différentes feuilles sont listées deux fois dans la feuille récapitulative lors de l'exécution du script (alors qu'évidemment ils ne devraient l'être qu'une seule fois).

A priori, je ne vois rien dans ton code qui explique ce phénomène.
Est-ce que ça ne viendrait pas des données sources ?

Citation:

A peine environ une centaine de lignes au total, mais comme les données des différentes feuilles changent régulièrement, j'aimerai éviter de devoir les copier/coller manuellement dans la feuille récapitulative à chaque fois...

Ce n'était pas l'objet de ma remarque.
Je signalais juste que ce Delete sur 65 000 lignes dans ton code fait un énorme travail inutile ce qui génère certainement des ralentissement et qu'il est possible d'écrire des instructions plus efficaces.
08/11/2017, 10h27
Philippe Tulliez

Bonjour,
Comme la relevé très justement Menhir que je salue au passage, voir une fonction "clé sur porte" proposée dans cette contribution titrée Regrouper plusieurs feuilles sur une autre. (2003-2010)

Citation:

Envoyé par Menhir

Comme le côté obscure de la Force, c'est un chemin plus rapide et plus séduisant.

Ca je ne te le fais pas dire ! Bon, à terme il faudrait effectivement que je me penche sérieusement là-dessus, surtout que c'est un besoin qui revient régulièrement. Merci pour le lien :)

Citation:

Envoyé par Menhir

A priori, je ne vois rien dans ton code qui explique ce phénomène.
Est-ce que ça ne viendrait pas des données sources ?

Non, j'ai bien vérifié, et j'ai également essayé en ne gardant que cette partie du code (sait-on jamais) :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Dim dlgR As Integer, dlgi As Integer Dim i As Byte 'Sélectionne la feuille récapitulative et supprime les résultats précédents Sheets("Liste").Activate Range("A:D").Cells.Clear 'Liste les données de toutes les autres feuilles dans la feuille "Liste" For i = 1 To Worksheets.Count If UCase(Sheets(i).Name) <> "Liste" Then dlgR = Sheets("Liste").Range("A" & Rows.Count).End(xlUp).Row With Sheets(i) dlgi = .Range("A" & Rows.Count).End(xlUp).Row .Range("A2:D" & dlgi).Copy Sheets("Liste").Range("A" & dlgR + 1) End With End If Next
Sinon, j'avais déjà trouvé ce topic précédemment, mais le code est un peu difficile à adapter quand on ne s'y connait pas, d'où mes recherches d'un script plus court sur le web.

08/11/2017, 13h11
Philippe Tulliez

Bonjour,
Je n'ai pas regardé l'ensemble de ton code mais cette ligne m'interpelle

Code:

If UCase(Sheets(i).Name) <> "Liste" Then

car effectuer ce test ou ne rien tester c'est du pareil au même :lol:
08/11/2017, 13h20
Menhir

Bravo Philippe :ccool: , je ne l'avais pas remarquée celle-là.

Donc le mystère est levé, tes données sont dupliquées parce que recopiées de la feuille de synthèse.