regroupement de données de plusieurs feuilles sur une feuille Récap

C

cilou

XLDnaute Nouveau
Bonjour,
J'ai un fichier avec 6 onglets, je souhaiterais regrouper ces 6 feuilles sur une 7ème feuillle "Total", en compilant les données de toutes les feuilles les unes en dessous des autres (sachant que les titres des colonnes (A-Y) sont les mêmes sur toutes les feuilles, et les données à récupérer ne commencent qu'à partir de la ligne 3!) J'ai créé un code VBA, malheureusement il ne me compile que 3 lignes de chaque feuille, et pas toutes les lignes non vides... Pourriez-vous m'aider? Merci!
Voici le code:

Sub TransfertOpérations()
Dim MyRange As Range
Dim i As Integer, j As Byte
Dim C As Variant
Dim S As String

Application.ScreenUpdating = False
Sheets("TOTAL-CHAUDRON").Range("A1:Y3000").ClearContents

Set MyRange = Range(Sheets("BARBIER-A.").[A3], Sheets("BARBIER-A.").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C

Set MyRange = Range(Sheets("BARBIER-S.").[A3], Sheets("BARBIER-S.").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C

Set MyRange = Range(Sheets("CAMPHIN").[A3], Sheets("CAMPHIN").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C

Set MyRange = Range(Sheets("FAUVEAUX").[A3], Sheets("FAUVEAUX").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C

Set MyRange = Range(Sheets("GURGUL").[A3], Sheets("GURGUL").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C

Set MyRange = Range(Sheets("STELMASZYK").[A3], Sheets("STELMASZYK").[A1000].End(xlUp))
For Each C In MyRange
C.EntireRow.Range("A3:Y3").Copy
Sheets("TOTAL-CHAUDRON").Range("A2850").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Next C
End Sub
 
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : regroupement de données de plusieurs feuilles sur une feuille Récap

Bonjour Cilou, bonjour le forum,

Essaie comme ça :
Code: 
Sub TransfertOpérations()
Dim oc As Object 'déclare la variable oc (Onglet Cible)
Dim o As Object 'déclare la variable o (Onglet)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)


Application.ScreenUpdating = False 'masque les changements à l'écran
Set oc = Sheets("TOTAL-CHAUDRON") 'définit l'onglet cible
oc.Range("A1:Y" & oc.Cells(Application.Rows.Count, "y").End(xlUp).Row).ClearContents 'supprime les anciennes données
For Each o In Sheets 'boucle sur tous les onglets du classeur
    If Not o.Name = "TOTAL-CHAUDRON" Then 'condition : si le nom de l'onglet est différent de "TOTAL-CHAUDRON"
        Set dest = oc.Range(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la celllule de destination dest
        dl = o.Cells(Application.Rows.Count, 1) 'définit la dernière ligne édité de la colonne A de l'onglet o
        .Range("A3:Y" & dl).Copy dest 'copy la plage éditée de l'onglet o et la colle dans dest
    End If 'fin de la condition
Next o 'prochain onglet de la boucle
Application.ScreenUpdating = True 'affiche les changements à l écran
End Sub
 
Vote positif 0 Vote négatif
C

cilou

XLDnaute Nouveau
Re : regroupement de données de plusieurs feuilles sur une feuille Récap

Merci pour cette proposition! Mais cela me renvoit erreur de compilation 'référence incorrecte ou non qualifiée', en surlignant ".Range" à la 12ème ligne... Comment modifier cela?
 
Vote positif 0 Vote négatif
C

cilou

XLDnaute Nouveau
Re : regroupement de données de plusieurs feuilles sur une feuille Récap

J'en profite pour détailler un peu mon problème, en réalité, je ne voudrais copier que les colonnes A-DEF-LMNOPQR-TUVWXY (soit tout sauf B-C et S) de chaque feuille, si vous pouviez m'aider pour cela aussi, ce serait vraiment sympa!
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : regroupement de données de plusieurs feuilles sur une feuille Récap

Bonjour Cilou, bonjour le forum,

En effet il manque un o devant le point, désolé. Le code corrigé :
Code: 
Sub TransfertOpérations()
Dim oc As Object 'déclare la variable oc (Onglet Cible)
Dim o As Object 'déclare la variable o (Onglet)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)

Application.ScreenUpdating = False 'masque les changements à l'écran
Set oc = Sheets("TOTAL-CHAUDRON") 'définit l'onglet cible
oc.Range("A1:Y" & oc.Cells(Application.Rows.Count, "y").End(xlUp).Row).ClearContents 'supprime les anciennes données
For Each o In Sheets 'boucle sur tous les onglets du classeur
    If Not o.Name = "TOTAL-CHAUDRON" Then 'condition : si le nom de l'onglet est différent de "TOTAL-CHAUDRON"
        Set dest = oc.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la celllule de destination dest
        dl = o.Cells(Application.Rows.Count, 1) 'définit la dernière ligne édité de la colonne A de l'onglet o
        o.Range("A3:Y" & dl).Copy dest 'copy la plage éditée de l'onglet o et la colle dans dest
    End If 'fin de la condition
Next o 'prochain onglet de la boucle
Application.ScreenUpdating = True 'affiche les changements à l écran
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : regroupement de données de plusieurs feuilles sur une feuille Récap

Bonjour Cilou, bonjour le forum,

Ne soit pas désolée car c'est moi qui n'ai pas testé avant d'envoyer. Je le fait rarement mais chaque fois que je le fais je me plante... J'ai corrigé au dessus et je cherche pour ton nouveau problème...
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : regroupement de données de plusieurs feuilles sur une feuille Récap

Bonjour Cilou, bonjour le forum,

Bon, cette fois j'ai testé, corrigé encore des erreurs (ooops désolé encore) mais je pense que ça devrait convenir :
Code: 
Sub TransfertOpérations()
Dim oc As Object 'déclare la variable oc (Onglet Cible)
Dim o As Object 'déclare la variable o (Onglet)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim pl As Range 'déclare la variable pl

Application.ScreenUpdating = False 'masque les changements à l'écran
Set oc = Sheets("TOTAL-CHAUDRON") 'définit l'onglet cible
oc.Range("A1:Y" & oc.Cells(Application.Rows.Count, "y").End(xlUp).Row).ClearContents 'supprime les anciennes données
For Each o In Sheets 'boucle sur tous les onglets du classeur
    If Not o.Name = "TOTAL-CHAUDRON" Then 'condition : si le nom de l'onglet est différent de "TOTAL-CHAUDRON"
        Set dest = oc.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest
        dl = o.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne édité de la colonne A de l'onglet o
        Set pl = Application.Union(o.Range("A3:A" & dl), o.Range("D3:F" & dl), o.Range("L3:R" & dl), o.Range("T3:Y" & dl))
        pl.Copy dest 'copy la plage éditée de l'onglet o et la colle dans dest
    End If 'fin de la condition
Next o 'prochain onglet de la boucle
Application.ScreenUpdating = True 'affiche les changements à l écran
End Sub
 
Vote positif 0 Vote négatif
C

cilou

XLDnaute Nouveau
Re : regroupement de données de plusieurs feuilles sur une feuille Récap

Désolé de cette réponse tardive, cela fonctionne bien, en revanche cela me renvoie également les lignes vides, ce qui signifie que les données de la 2ème feuille se situent vers la ligne 3700!!! Je cherche un moyen d'y remédier, si vous savez comment faire j'attends votre réponse! Merci en tout cas!
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : regroupement de données de plusieurs feuilles sur une feuille Récap

Bonjour Cilou, bonjour le forum,

Et si tu mettais ton fichier en pièce jointe (ou un fichier exemple basé sur ton fichier) ? On perdrait peut-être moins de temps non ?

Cette nouvelle proposition risque de mettre plus de temps car elle teste ligne par ligne pour savoir si la ligne contient des données :
Code: 
Sub TransfertOpérations()
Dim oc As Object 'déclare la variable oc (Onglet Cible)
Dim o As Object 'déclare la variable o (Onglet)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim pl As Range 'déclare la variable pl
Dim cel As Range 'déclare la variable cel
Dim x As Integer 'déclare la variable x

Application.ScreenUpdating = False 'masque les changements à l'écran
Set oc = Sheets("TOTAL-CHAUDRON") 'définit l'onglet cible
oc.Range("A1:Y" & oc.Cells(Application.Rows.Count, "y").End(xlUp).Row).ClearContents 'supprime les anciennes données
For Each o In Sheets 'boucle 1 : sur tous les onglets du classeur
    If Not o.Name = "TOTAL-CHAUDRON" Then 'condition : si le nom de l'onglet est différent de "TOTAL-CHAUDRON"
        dl = o.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne édité de la colonne A de l'onglet o
        For x = 3 To dl 'boucle 2 : de la ligne 3 à la dernière ligne dl
            Set dest = IIf(oc.Range("A1") = "", oc.Range("A1"), oc.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)) 'définit la cellule de destination dest (A1 si A1 est vide, sinon A...)
            If Application.WorksheetFunction.CountA(o.Range(o.Cells(x, 1), o.Cells(x, 25))) <> 0 Then 'condition : si il y a au moins une cellule éditée dans les colonne A à Y
                Set pl = Application.Union(o.Cells(x, 1), o.Range(o.Cells(x, 4), o.Cells(x, 6)), o.Range(o.Cells(x, 12), o.Cells(x, 18)), o.Range(o.Cells(x, 20), o.Cells(x, 25)))
                pl.Copy dest 'copy la plage éditée de l'onglet o et la colle dans dest
            End If 'fin de la condition
        Next x 'prochaine ligne de la boucle 2
    End If 'fin de la condition
Next o 'prochain onglet de la boucle 1
Application.ScreenUpdating = True 'affiche les changements à l écran
End Sub
 
Vote positif 0 Vote négatif
C

cilou

XLDnaute Nouveau
Re : regroupement de données de plusieurs feuilles sur une feuille Récap

Bonjour,

Hier soir j'ai essayé un autre code qui marche très bien mais il est vraiment long à exécuter (surtout si l'on considère que chaque feuille possède plusieurs centaines de lignes...)
Voici un exemple de mon fichier avec ma macro!
 

Pièces jointes

  • Classeur1-TEST.xlsm
    19.1 KB · Affichages: 48
  • Classeur1-TEST.xlsm
    19.1 KB · Affichages: 48
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : regroupement de données de plusieurs feuilles sur une feuille Récap

Bonjour Cilou, bonjour le forum,

Pfff... tu parles d'un exemple ! Il y a à peine deux données qui se battent en duel !... Comment tu veux faire des tests comparatifs ?
En plus, ça ne correspond plus à ta demande antérieure où tu ne voulais que certaines colonnes... Au lieu de copier les valeurs tu mets des formules. Est-ce bien nécessaire puisqu'à chaque ouverture du classeur elles seront effacées ? Bref je comprends plus rien... Je sais plus quoi te dire ni quoi te proposer...

En désespoir de cause, en pièce jointe, ton fichier modifié avec le code ci-dessous :
Code: 
Private Sub Workbook_Open()
Dim oc As Object 'déclare la variable oc (Onglet Cible)
Dim ad As Range 'déclare la variable ad (Anciennes Données)
Dim o As Object 'déclare la variable o (Onglet)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)

Application.ScreenUpdating = False 'masque les changements à l'écran
Set oc = Sheets("Feuil3") 'définit l'onglet cible
Set ad = oc.Range("A2").CurrentRegion 'définit la plage des anciennes données
If ad.Rows.Count > 1 Then 'condition si la plage ad compte plus d'une seule ligne
    Set ad = ad.Offset(1, 0).Resize(ad.Rows.Count - 1, ad.Columns.Count) 'redéfinit la plage ad (sans la première ligne)
    ad.ClearContents 'efface les anciennes données
End If 'fin de la condition
For Each o In Sheets 'boucle 1 : sur tous les onglets du classeur
    If Not o.Name = "Feuil3" Then 'condition : si le nom de l'onglet est différent de "Feuil3"
        dl = o.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne A de l'onglet o
        Set pl = o.Range("A3:A" & dl) 'définit la plage pl
        For Each cel In pl 'boucle sur toutes les cellules de la plage pl
            Set dest = oc.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest
            'si la cellule n'est pas vide, copie les cellules visibles de la ligne dans dest
            If cel.Value <> "" Then cel.EntireRow.SpecialCells(xlCellTypeVisible).Copy dest
        Next cel 'prochaine cellule de la plage pl
    End If 'fin de la condition
Next o 'prochain onglet de la boucle 1
Application.ScreenUpdating = True 'affiche les changements à l écran
End Sub
le fichier :

 

Pièces jointes

  • Cilou_v01.xls
    73 KB · Affichages: 49
Vote positif 0 Vote négatif

Discussions similaires

Z
  • Résolu(e)
Microsoft 365 Problème de combinaison entre fonctions "If Then Else" et "SelectCase"
Réponses
11
Affichages
223
Zonmé
Z
S
  • Résolu(e)
Autres Copier-Coller en recherchant une ligne spécifique VBA
Réponses
4
Affichages
276
sambio2
S
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
203
Compte Supprimé 979
C
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
256
robpellan52
R
Usine à gaz
  • Résolu(e)
XL 2021 Ecrire dans une une autre feuille
Réponses
3
Affichages
302
Usine à gaz
Usine à gaz
S
  • Question
XL 2021 macro VBA excel
Réponses
1
Affichages
160
crocrocro
C
F
  • Résolu(e)
XL 2021 fermeture du classeur après apple d'un userform d'un autre classeur ouvert
Réponses
2
Affichages
87
farid
F
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
517
mouchtre
mouchtre
O
  • Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
437
olivier388
O
G
  • Question
Microsoft 365 Incompatibilité de type - Array
Réponses
2
Affichages
215
guiyom
G

Membres actuellement en ligne

18 membres et 297 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 097
Messages
2 085 261
Membres
102 844
dernier inscrit
atori2