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

FCMLE44 · 23 Août 2023

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

cp4 · 3 Octobre 2023

Bonjour tout le monde,

@FCMLE44 : Si j'ai bien compris, code modifié à tester.

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 And ws.Cells(dl2, 1) <> "" 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...

FCMLE44 · 2 Octobre 2023

Bonjour
Certains des utilisateurs remplissent la colonne A sans rien nécessairement dans les colonnes d'aprés
Si il y a rien dans les colonnes d'après alors il doit considérer la ligne comme vide

Cousinhub · 2 Octobre 2023

Bonjour,
Dans la requête de Rachid
Tu accèdes à l'éditeur Power Query en appuyant simultanément sur Alt + F12
A droite, tu vois les étapes

Tu sélectionnes l'étape nommée "Lignes filtrées1" (comme sur la photo)
Dans la barre de formule (si elle n'est pas présente, tu vas dans le ruban "Affichage, et tu valides "Barre de formule"), tu vois le filtre appliqué, et ici, il est sur la colonne SOCIETE
Remplace SOCIETE par NOM (par exemple), puis "Fichier/Fermer et Charger" (attention, garde bien les [ et ] )

FCMLE44 · 2 Octobre 2023

Cousinhub à dit:
Bonjour,
Dans la requête de Rachid
Tu accèdes à l'éditeur Power Query en appuyant simultanément sur Alt + F12
A droite, tu vois les étapes
Regarde la pièce jointe 1180189
Tu sélectionnes l'étape nommée "Lignes filtrées1" (comme sur la photo)
Dans la barre de formule (si elle n'est pas présente, tu vas dans le ruban "Affichage, et tu valides "Barre de formule"), tu vois le filtre appliqué, et ici, il est sur la colonne SOCIETE
Remplace SOCIETE par NOM (par exemple), puis "Fichier/Fermer et Charger" (attention, garde bien les [ et ] )

Regarde la pièce jointe 1180191

Merci mais je n'utilises pas la requête de Rachid mais la macro de CP4

danielco · 2 Octobre 2023

Bonjour,
Avec des formules (indiquées en jaune)

Daniel

cp4 · 3 Octobre 2023

Bonjour tout le monde,

@FCMLE44 : Si j'ai bien compris, code modifié à tester.

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 And ws.Cells(dl2, 1) <> "" 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

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

FCMLE44

XLDnaute Impliqué

Pièces jointes

cp4

FCMLE44

XLDnaute Impliqué

Cousinhub

XLDnaute Barbatruc

Pièces jointes

FCMLE44

XLDnaute Impliqué

danielco

XLDnaute Accro

Pièces jointes

cp4

XLDnaute Barbatruc

Discussions similaires