XL 2021 Insérer le nom de chaque feuille dans un tableau récap

[Driff042]

Bonjour à toutes et tous,
J'ai recherché en vain, sur le forum, pour faire remonter le nom de chaque feuille créée dans un tableau récap mis en forme.

Quelqu'un pourrait m'aider SVP ?
bonne journée

 

[vgendron]

Bonjour

Peux tu stp poster un fichier exemple pour voir à quoi ressemble ton tableau récap?

 

[Driff042]

Bonjour

Peux tu stp poster un fichier exemple pour voir à quoi ressemble ton tableau récap?

 

[Driff042]

Le voici !
merci

 

[vgendron]

voici une solution par macro (qui m'oblige à ajouter une colonne "NomTableau")

 

[vgendron]

le meme SANS la colonne intermédiaire

 

[goube]

Bonjour à tous,

Un essai avec Power Query.
Il faut nommer les tableaux avec le nom de l'onglet en utilisant l'underscore à la place des espaces.
Cordialement

 

[Driff042]

le meme SANS la colonne intermédiaire

Bonjour vgendron,
merci pour le fiichier, mais il semble qu'il ait un bug, la liste s'efface quand je clic sur le bouton "Listing" avec le message Bug.
Cela fonctionne sur votre machine?

 

[vgendron]

Hello
oui ca fonctionne

il faut bien que les feuilles contiennent les données sous forme de table structurée

 

[goube]

Bonjour,
Pas de retour sur ma proposition ?
Cordialement

 

[AtTheOne]

Bonjour à toutes et à tous, bonjour @Driff042 , @vgendron , @goube
Je propose une solution VBA qui préserve les données déjà collectées dans le tableau "tb_Bilan" (je l'ai renommé) de la feuille Bilan, en particulier si la colonne Programme contient déjà des données.
Cette solution évite également la propagation automatique des formules dans les colonnes calculées (c'est le cas avec ta solution @vgendron, il n'y a qu'une seule formule dans les colonnes calculées)

Le code est le suivant :

Sub Lister_Feuilles()
     Dim WSh As Worksheet, DC As Object
     Dim tablo(), Lgn1(), nb_Cols%, nb_Lgns%
    
     'Mémorisation des formules de la 1ère ligne
     Lgn1 = Application.[tb_Bilan].Rows(1).FormulaLocal
     'Mettre des constantes dans la 1ère ligne pour éviter l'extention automatique des formules dans le tabeau
     [tb_Bilan].Rows(1).Value = [tb_Bilan].Rows(1).Value
    
     'Tableau Actuel (pour ne pas effacer les données déjà saisies) (transposer pour utiliser REDIM)
     tablo = Application.Transpose([tb_Bilan].FormulaLocal)
     nb_Cols = UBound(tablo, 1)
     nb_Lgns = UBound(tablo, 2)
    
     'Feuilles déjà listées dans le tableau
     Set DC = CreateObject("Scripting.dictionary")
     For i = 1 To UBound(tablo, 2)
          DC(tablo(1, i)) = i
     Next
    
     'Collecte des nouvelles feuilles
     '(hors feuilles "Bilan", feuilles déjà collectées, feuilles sans ou avec plusieurs Listobject)
     For Each WSh In ThisWorkbook.Worksheets
          NomSh = WSh.Name
          If NomSh <> "Bilan" And Not DC.exists(NomSh) And WSh.ListObjects.Count = 1 Then
               nb_Lgns = nb_Lgns + 1: ReDim Preserve tablo(1 To nb_Cols, 1 To nb_Lgns)
               NomLO = WSh.ListObjects(1).Name
               tablo(1, nb_Lgns) = WSh.Name
               tablo(2, nb_Lgns) = "=" & NomLO & "[[#Totaux];[Total]]"
               tablo(4, nb_Lgns) = "=" & NomLO & "[[#Totaux];[Montant]]"
          End If
     Next
    
     'Redimensionnement du tableau
     [tb_Bilan].ListObject.Resize [tb_Bilan].ListObject.Range.Resize(nb_Lgns + 2) ' +2 = lignes entête et ligne total
    
     'Collage des formules
     [tb_Bilan].FormulaLocal = Application.Transpose(tablo)
     'Restitution des formule de la 1ère ligne
     [tb_Bilan].Rows(1).FormulaLocal = Lgn1
     'Suppression de la 1ère ligne si elle était vide
     If [tb_Bilan].Cells(1, 1) = "" Then [tb_Bilan].ListObject.ListRows(1).Delete
    
End Sub

Voir le fichier joint
et merci de faire un retour à nos post ! 😉

 

[AtTheOne]

Bonsoir à toutes & à tous, bonsoir @Driff042, @vgendron , @goube,
en regardant les propositions formulées je me suis rendu compte que j'avais oublié de trier, c'est chose faite maintenant :

Sub Lister_Feuilles()
     Dim WSh As Worksheet, DC As Object
     Dim tablo(), Lgn1(), nb_Cols%, nb_Lgns%
    
     'Mémorisation des formules de la 1ère ligne
     Lgn1 = Application.[Tb_Bilan].Rows(1).FormulaLocal
     'Mettre des constantes dans la 1ère ligne pour éviter l'extention automatique des formules dans le tabeau
     [Tb_Bilan].Rows(1).Value = [Tb_Bilan].Rows(1).Value
    
     'Tableau Actuel (pour ne pas effacer les données déjà saisies) (transposer pour utiliser REDIM)
     tablo = Application.Transpose([Tb_Bilan].FormulaLocal)
     nb_Cols = UBound(tablo, 1)
     nb_Lgns = UBound(tablo, 2)
    
     'Feuilles déjà listées dans le tableau
     Set DC = CreateObject("Scripting.dictionary")
     For i = 1 To UBound(tablo, 2)
          DC(tablo(1, i)) = i
     Next
    
     'Collecte des nouvelles feuilles
     '(hors feuilles "Bilan", feuilles déjà collectée, feuille sans ou avec plusieurs Listobject)
     For Each WSh In ThisWorkbook.Worksheets
          NomSh = WSh.Name
          If NomSh <> "Bilan" And Not DC.exists(NomSh) And WSh.ListObjects.Count = 1 Then
               nb_Lgns = nb_Lgns + 1: ReDim Preserve tablo(1 To nb_Cols, 1 To nb_Lgns)
               NomLO = WSh.ListObjects(1).Name
               tablo(1, nb_Lgns) = WSh.Name
               tablo(2, nb_Lgns) = "=" & NomLO & "[[#Totaux];[Total]]"
               tablo(4, nb_Lgns) = "=" & NomLO & "[[#Totaux];[Montant]]"
          End If
     Next
    
     'Redimensionnement du tableau
     [Tb_Bilan].ListObject.Resize [Tb_Bilan].ListObject.Range.Resize(nb_Lgns + 2) ' +2 = lignes entête et ligne total
    
     'Collage des formules
     [Tb_Bilan].FormulaLocal = Application.Transpose(tablo)
     'Restitution des formule de la 1ère ligne
     [Tb_Bilan].Rows(1).FormulaLocal = Lgn1
     'Suppression de la 1ère ligne si elle était vide
     If [Tb_Bilan].Cells(1, 1) = "" Then [Tb_Bilan].ListObject.ListRows(1).Delete
    
     With [Tb_Bilan].ListObject.Sort
          .SortFields.Clear
          .SortFields.Add Key:=[tb_bilan[Projet]], DataOption:=xlSortTextAsNumbers
          .Header = xlYes
          .Apply
     End With
    
End Sub

Voir le fichier joint
À bientôt (du moins j'espère !)

 

[vgendron]

Hello AtTheOne

j'avais gardé le sujet de coté, car pris sur un autre, je reviens donc
je ne comprend ce que tu veux dire sur la propagation des formules dans ma solution..
à chaque ligne, la formule est bien différente puisque la référence au tableau change
et ce.. comme ta solution.. sauf que toi, tu prends la peine de sauvegarder ce qui a déjà été fait pour lister juste les nouvelles feuilles
perso. j'ai pris le parti de tout effacer et tout relister..(moins compliqué car pas besoin de dico,array...;
il y a donc sans doute un truc qui m'échappe dans ton commentaire..??

 

[AtTheOne]

Bonjour @vgendron,
Sur une de mes versions (2007 ou 2021 il faut que je vérifie)
La dernière formule placée par le code se propage à toute la colonne ...
Je revérifie ce soir et je reviens vers toi.
À plus

 

[vgendron]

Bonjour @vgendron,
Sur une de mes versions (2007 ou 2021 il faut que je vérifie)
La dernière formule placée par le code se propage à toute la colonne ...
Je revérifie ce soir et je reviens vers toi.
À plus

il y a une option (directement dans la table???) qui permet de désactiver cette propagation..