Microsoft 365 Rassembler les données de plusieurs feuilles dans une feuille récapitulative

F

FCMLE44

XLDnaute Impliqué
Supporter XLD
Bonjour

Dans le fichier en pièce jointe, je souhaite rapatrier dans la feuille RECAP, toutes les données des autres onglets de cette manière
Colonne A et B des onglets dans les colonnes A et B de la feuille Récap
En colonne C de la feuille RECAP, le nom de l'onglet d'ou provient les données rapatriée
Colonne C à K des onglets dans les colonnes D à L de la feuille Récap

Dans un second temps, je souhaiterais pouvoir créer un ou des onglets identiques à celui déja présent uniquement avec le tableau mais sans données

Quelqu'un aurait une idée ?

Merci
 

Pièces jointes

  • Classeur2.xlsx
    34.1 KB · Affichages: 20
Trier par date Trier par votes
cp4

cp4

XLDnaute Barbatruc
Bonjour,

J'ai supposé que l'on doit récupérer les données de toutes les feuilles du classeur dans la feuille Recap.
Code à mettre dans un module standard à appeler à l'activation de la feuille Recap ou via un bouton.
VB: 
Option Explicit

Sub Recapitulation()
   Dim ws As Worksheet, dl As Long, dl2 As Long, Fr As Worksheet, c As Range
   Set Fr = ThisWorkbook.Worksheets("recap")
   Application.ScreenUpdating = False
   With Fr
      dl = .Cells(Rows.Count, 1).End(xlUp).Row
      If dl > 5 Then .Range(.Cells(6, 1), .Cells(dl, 12)).ClearContents
   End With

   For Each ws In Worksheets
      If ws.Name <> "RECAP" Then
         dl2 = ws.Cells(Rows.Count, 1).End(xlUp).Row
         For Each c In ws.Range(ws.Cells(6, 1), ws.Cells(dl2, 1))
            dl = Fr.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Fr.Cells(dl, 1) = c
            Fr.Cells(dl, 2) = c.Offset(0, 1)
            Fr.Cells(dl, 3) = ws.Name
            Fr.Cells(dl, 4) = c.Offset(0, 2)
            Fr.Cells(dl, 5) = c.Offset(0, 3)
            Fr.Cells(dl, 6) = c.Offset(0, 4)
            Fr.Cells(dl, 7) = c.Offset(0, 5)
            Fr.Cells(dl, 8) = c.Offset(0, 6)
            Fr.Cells(dl, 9) = c.Offset(0, 7)
            Fr.Cells(dl, 10) = c.Offset(0, 8)
            Fr.Cells(dl, 11) = c.Offset(0, 9)
            Fr.Cells(dl, 12) = c.Offset(0, 10)
         Next c
      End If
   Next
   Application.ScreenUpdating = True
   MsgBox "Recap terminée!", vbInformation + vbOKOnly, "TRAITEMENT"

End Sub
 
Vote positif 0 Vote négatif
F

FCMLE44

XLDnaute Impliqué
Supporter XLD
cp4 à dit:
Bonjour,

J'ai supposé que l'on doit récupérer les données de toutes les feuilles du classeur dans la feuille Recap.
Code à mettre dans un module standard à appeler à l'activation de la feuille Recap ou via un bouton.
VB: 
Option Explicit

Sub Recapitulation()
   Dim ws As Worksheet, dl As Long, dl2 As Long, Fr As Worksheet, c As Range
   Set Fr = ThisWorkbook.Worksheets("recap")
   Application.ScreenUpdating = False
   With Fr
      dl = .Cells(Rows.Count, 1).End(xlUp).Row
      If dl > 5 Then .Range(.Cells(6, 1), .Cells(dl, 12)).ClearContents
   End With

   For Each ws In Worksheets
      If ws.Name <> "RECAP" Then
         dl2 = ws.Cells(Rows.Count, 1).End(xlUp).Row
         For Each c In ws.Range(ws.Cells(6, 1), ws.Cells(dl2, 1))
            dl = Fr.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Fr.Cells(dl, 1) = c
            Fr.Cells(dl, 2) = c.Offset(0, 1)
            Fr.Cells(dl, 3) = ws.Name
            Fr.Cells(dl, 4) = c.Offset(0, 2)
            Fr.Cells(dl, 5) = c.Offset(0, 3)
            Fr.Cells(dl, 6) = c.Offset(0, 4)
            Fr.Cells(dl, 7) = c.Offset(0, 5)
            Fr.Cells(dl, 8) = c.Offset(0, 6)
            Fr.Cells(dl, 9) = c.Offset(0, 7)
            Fr.Cells(dl, 10) = c.Offset(0, 8)
            Fr.Cells(dl, 11) = c.Offset(0, 9)
            Fr.Cells(dl, 12) = c.Offset(0, 10)
         Next c
      End If
   Next
   Application.ScreenUpdating = True
   MsgBox "Recap terminée!", vbInformation + vbOKOnly, "TRAITEMENT"

End Sub
Cliquez pour agrandir...
Bonjour

Lorsque je lance la macro sans données dans les onglets, j'obtiens les données de la ligne 5, est ce possible de rajouter une condition à ce code en disant si vide alors rien

Merci
 
Vote positif 0 Vote négatif
cp4

cp4

XLDnaute Barbatruc
FCMLE44 à dit:
Bonjour

Lorsque je lance la macro sans données dans les onglets, j'obtiens les données de la ligne 5, est ce possible de rajouter une condition à ce code en disant si vide alors rien

Merci
Cliquez pour agrandir...
Bonsoir,
En ajoutant une condition sur la dernière ligne non vide de la colonne A.
VB: 
Option Explicit

Sub Recapitulation()
   Dim ws As Worksheet, dl As Long, dl2 As Long, Fr As Worksheet, c As Range
   Set Fr = ThisWorkbook.Worksheets("recap")
   Application.ScreenUpdating = False
   With Fr
      dl = .Cells(Rows.Count, 1).End(xlUp).Row
      If dl > 5 Then .Range(.Cells(6, 1), .Cells(dl, 12)).ClearContents
   End With

   For Each ws In Worksheets
      If ws.Name <> "RECAP" Then
         dl2 = ws.Cells(Rows.Count, 1).End(xlUp).Row
         If dl2 > 5 Then
            For Each c In ws.Range(ws.Cells(6, 1), ws.Cells(dl2, 1))
               dl = Fr.Cells(Rows.Count, 1).End(xlUp).Row + 1
               Fr.Cells(dl, 1) = c
               Fr.Cells(dl, 2) = c.Offset(0, 1)
               Fr.Cells(dl, 3) = ws.Name
               Fr.Cells(dl, 4) = c.Offset(0, 2)
               Fr.Cells(dl, 5) = c.Offset(0, 3)
               Fr.Cells(dl, 6) = c.Offset(0, 4)
               Fr.Cells(dl, 7) = c.Offset(0, 5)
               Fr.Cells(dl, 8) = c.Offset(0, 6)
               Fr.Cells(dl, 9) = c.Offset(0, 7)
               Fr.Cells(dl, 10) = c.Offset(0, 8)
               Fr.Cells(dl, 11) = c.Offset(0, 9)
               Fr.Cells(dl, 12) = c.Offset(0, 10)
            Next c
         End If
      End If
   Next
   Application.ScreenUpdating = True
   MsgBox "Recap terminée!", vbInformation + vbOKOnly, "TRAITEMENT"

End Sub
 
Vote positif 0 Vote négatif
R@chid

R@chid

XLDnaute Barbatruc
Bonjour @ tous,
Tu peux convertir tes tableaux en tableaux structurés d'Excel et te servir de PowerQuery pour récupérer les informations de tous les tableaux dont le nom commence par GST.

Un simple clic-droit dans le tableau vert puis actualiser fera l'affaire.

Bien cordialement
 

Pièces jointes

  • FCMLE44_PowerQuery.xlsx
    43.2 KB · Affichages: 11
Vote positif 0 Vote négatif

Discussions similaires

N
  • Question
XL 2019 recuperer données sur plusieurs feuilles
Réponses
13
Affichages
248
danielco
D
L
  • Question
XL 2016 Aide pour données de plusieurs fichiers
Réponses
2
Affichages
260
LudoM28
L
J
  • Question
Microsoft 365 extraction VBA avec formule si
Réponses
10
Affichages
335
Phil69970
Phil69970
V
  • Question
XL 2021 avoir des données dans plusieurs onglets en fonction de plusieurs conditions
Réponses
5
Affichages
157
mapomme
mapomme
P
  • Question
Autres Ne pas reporter données si feuille masquée
Réponses
7
Affichages
207
pamela85200
P
N
  • Résolu(e)
XL 2019 Joindre des données de plusieurs feuilles
Réponses
4
Affichages
276
Nasseuz
N
D
  • Question
Microsoft 365 Infos dans plusieurs onglets à réorganiser dans plusieurs onglets
Réponses
7
Affichages
312
fanfan38
fanfan38
Akortys
  • Question
Microsoft 365 RESOLU - Macro - Recherche de lignes identiques et ressortir les lignes uniques
Réponses
2
Affichages
232
Akortys
Akortys
hypo78
  • Question
XL 2016 Récupérer données sur plusieurs feuilles
2
Réponses
18
Affichages
566
Lolote83
L
R
  • Question
XL 2010 Effacement de données dans plusieurs feuilles de calcul dans un même classeur
Réponses
3
Affichages
325
robbynasch
R

Membres actuellement en ligne

16 membres et 147 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 207
Messages
2 086 244
Membres
103 162
dernier inscrit
fcfg