XL 2010 Récupérer données de plusieurs onglets sur un seul

kaisermpt

XLDnaute Occasionnel
Bonjour,

Je me permets de vous solliciter pour un problème assez simple.

Je dois récupérer les données sur plusieurs fiches dans un seul onglet de consolidation avec le nom de l'onglet dans la colonne juste avant.

Les données sont situées dans chaque fiche sur le même modèle.

Je vous joints un exemple de mon fichier. Dans la réalité, j'ai plusieurs dizaines fiches à consolider

je reste à votre disposition pour tout complément d'information,

En vous remerciant d'avance

Bien cordialement

Sébastien
 

Pièces jointes

  • TEST_REPONSES.xlsx
    12.4 KB · Affichages: 40

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour kaiservoisin, bonjour le forum,

peut-être comme ça :

VB:
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (OngletS)
Dim OC As Worksheet 'déclare la variable OC (Onglet Conso)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OC = Worksheets("CONSO") 'définit l'onglet OC
OC.Cells.Clear 'efface des éventuelles anciennes données de l'onglet OC
For Each OS In Worksheets 'boucle sur tous les onglets OS du classeur
    If Not OS.Name = OC.Name Then 'condition : si le nom de l'onglet OS n'est pas le nom de l'onglet OC ("CONSO")
        'définit la cellule de destination DEST (B4 si B4 est vide sinon, la première cellule vide de la colonne B de l'onglet OC)
        If OC.Range("B4").Value = "" Then Set DEST = OC.Range("B4") Else Set DEST = OC.Cells(Application.Rows.Count, "B").End(xlUp).Offset(1, 0)
        OS.Range("B5").CurrentRegion.Copy DEST.Offset(0, 1) 'copie la plage des cellules adjacentes à B5 et la colle dans DEST
        DEST.Resize(6, 1).Value = OS.Name 'copie pour toutes les lignes le nom de l'onglet OS
    End If 'fin de la condition
Next OS 'prochain onglet de la boucle
End Sub
 

Robert

XLDnaute Barbatruc
Repose en paix
Re Sébastien,

Oui pardon, mon code n'était pas bon. Le nouveau code :

VB:
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (OngletS)
Dim OC As Worksheet 'déclare la variable OC (Onglet Conso)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim PL As Range 'déclare la variable PL (PLage)

Set OC = Worksheets("CONSO") 'définit l'onglet OC
OC.Cells.Clear 'efface des éventuelles anciennes données de l'onglet OC
For Each OS In Worksheets 'boucle sur tous les onglets OS du classeur
    If Not OS.Name = OC.Name Then 'condition : si le nom de l'onglet OS n'est pas le nom de l'onglet OC ("CONSO")
        'définit la cellule de destination DEST (B4 si B4 est vide sinon, la première cellule vide de la colonne B de l'onglet OC)
        If OC.Range("B4").Value = "" Then Set DEST = OC.Range("B4") Else Set DEST = OC.Cells(Application.Rows.Count, "B").End(xlUp).Offset(1, 0)
        Set PL = OS.Range("B5").CurrentRegion 'définit la plage PL
        Set PL = PL.Resize(PL.Rows.Count, PL.Columns.Count + 2) 'redéfinit la plage PL en ajoutant 2 colonnes
        PL.Copy DEST.Offset(0, 1) 'copie la plage PL et la colle dans DEST décalée d'une colonne à droite
        DEST.Resize(PL.Rows.Count, 1).Value = OS.Name 'copie pour toutes les lignes le nom de l'onglet OS
    End If 'fin de la condition
Next OS 'prochain onglet de la boucle
End Sub
 

Discussions similaires

M
Réponses
9
Affichages
468
Maikales
M

Statistiques des forums

Discussions
312 113
Messages
2 085 430
Membres
102 889
dernier inscrit
monsef JABBOUR