Macro pour afficher détail d'un TCD et renommer feuille générée

Etn

XLDnaute Occasionnel
Bonjour le forum !

Je fais de nouveau appel à votre aide car je me retrouve confronté au problème suivant :

Dans mon fichier (ci joint) je désire effectuer l'action suivante : Dans l'onglet TCD, afficher les détails en double cliquant sur les cellules B4, B5, B6 (etc) et pour chaque nouvelle feuille générée (avec le détail), la renommer avec l'étiquette de ligne correspondante (pour le premier renommer l'onglet "Bernard", le 2e renommer la feuille "Julie", etc).

J'ai essayé en enregistrant une macro, mais je ne vois pas comment programmer pour enchainer les uns à la suite des autres. (Dans le fichier joint il y en a 3, mais dans le vrai fichier il y en a 200).

Merci d'avance pour votre aide. N'hésitez pas à poser des questions si je n'ai pas été suffisamment clair, je répondrai rapidement.

Bonne journée.
 

Pièces jointes

  • Classeur TCD macro.xlsx
    14.5 KB · Affichages: 68
Dernière modification par un modérateur:

Robert

XLDnaute Barbatruc
Repose en paix
Re : Macro pour créer un onglet et renommer à partir d'une cellule

Bonjour Etn, bonjour le forum,

Essaie comme ça :

Code:
Sub Macro2()
Dim B As Worksheet 'déclare la variable B (onglet Base)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TT As Variant 'déclare la variable TT (Tableau Temporaire)
Dim TEST As Boolean 'déclare la variable TEST
Dim J As Integer 'déclare la variable J (incrément)

Set B = Worksheets("Base") 'définit l'onglet B
TV = B.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 1)) = "" 'alimente le dictionnaire D avec les données de la colonne 1 de TV
Next I 'prochaine ligne de la boucle
TT = D.keys 'récupère dans le tableau temporaire TT la liste des éléments du dictionnaire D sans doublon
For I = 0 To UBound(TT) 'boucle 1 : sur tous les éléments du tableau temporaire TT
    TEST = False 'initialise la variable TEST
    For J = 1 To Sheets.Count 'boucle 2 : sur tous les onglets du classeur
        'si l'élément de TT  est égal au nom de l'onglet, définit la variable TEST, sort de la boucle 2
        If TT(I) = Sheets(J).Name Then TEST = True: Exit For
    Next J 'prochain onglet de la boucle 2
    If TEST = False Then 'condition : si TEST est [FAUX]
        Worksheets.Add after:=Sheets(Sheets.Count) 'ajoute un nouvel onglet à la fin
        ActiveSheet.Name = TT(I) 'renomme l'onglet avec l'élément I du tableau temporaire TT
    End If 'fin de la condition
Next I 'prochain élément de la boucle 1
End Sub
 

Etn

XLDnaute Occasionnel
Re : Macro pour créer un onglet et renommer à partir d'une cellule

Bonjour Robert,

Tout d'abord merci pour ton aide.

J'ai essayé la macro que tu m'as donné, les feuilles se créent et sont nommées comme je le souhaite, néanmoins les feuilles sont vides et je n'ai pas le détail du TCD comme dans le fichier joint (feuille "Bernard").
Je regarde si j'arrive à trouver le moyen d'ajouter ça.

Edit :

Peut etre rajouter ça dans le code :
Code:
    Range("B4").Select
    Selection.ShowDetail = True

Je pense qu'il faudrait commencer par ça, puis ensuite renommer la feuille générée à l'aide du code de Robert.
Le problème c'est qu'il faut faire B4, puis B5, puis B6, etc.
 
Dernière modification par un modérateur:

Robert

XLDnaute Barbatruc
Repose en paix
Re : Macro pour créer un onglet et renommer à partir d'une cellule

Re,

Désolé Etn mais ce n'était pas spécifié dans ton énoncé... Comme je n'y connais rien en TCD je peut te proposer une autre méthode qui n'utilisera pas les tableaux. En attendant ta réponde...
 

Etn

XLDnaute Occasionnel
Re : Macro pour créer un onglet et renommer à partir d'une cellule

Re, désolé j'ai du mal m'exprimer.

Dans mon fichier (ci joint) je désire effectuer l'action suivante : Dans l'onglet TCD, développer les celulles B4, B5, B6 (etc) et pour chaque nouvel onglet créé, le renommer avec l'étiquette de ligne correspondante (pour le premier renommer l'onglet "Bernard", le 2e renommer la feuille "Julie", etc).

En fait quand je parle de développer, je sous-entend "afficher le détail".
Quand on double clique sur B4, B5 ou B6 dans le TCD, on génère une nouvelle feuille avec le détail contenu dans la base. C'est cette nouvelle feuille (avec le détail) que je souhaiterais renommer par le prénom colonne A de l'onglet TCD.

Merci quand même pour ton aide.
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Macro pour créer un onglet et renommer à partir d'une cellule

Re,

Regarde le fichier en pièce jointe. Il fait ce que tu demandes mais pas dans un tableau...
 

Pièces jointes

  • Etn_v01.xlsm
    23.7 KB · Affichages: 77

Etn

XLDnaute Occasionnel
Re : Macro pour créer un onglet et renommer à partir d'une cellule

Re,

En effet le résultat est là, néanmoins le chemin ne convient pas, il est nécessaire que les onglets soient générés à partir de "l'affichage des détails" du TCD.
Cependant je vais voir si je trouve une solution en mixant la macro pour afficher le détail d'une ligne d'un TCD et en y incorporant une partie de ton code (notamment les partie incrémenter+1 et renommer la feuille).

En tout cas merci pour ton aide, et je vais renommer le titre du sujet qui peut porter à confusion.
 

chris

XLDnaute Barbatruc
Re : Macro pour afficher détail d'un TCD et renommer feuille générée

Bonjour
Coucou Robert :D

Voici le code à placer dans un module standard
Code:
Option Explicit
Sub Extraction()
'
Dim col1 As Integer, Lenom As PivotItem
Application.ScreenUpdating = False
    With Worksheets("TCD").PivotTables(1)
        col1 = .DataBodyRange.Column
        'Ménage des feuilles + extraction
        Application.DisplayAlerts = False
        For Each Lenom In .RowFields(1).PivotItems
                If ExistWorkSheet(Lenom.Caption) Then Worksheets(Lenom.Caption).Delete
                Lenom.DataRange.ShowDetail = True
                ActiveSheet.Name = Lenom
                Worksheets("TCD").Activate
        Next Lenom
        Application.DisplayAlerts = True
        
    End With
Application.ScreenUpdating = True
End Sub

Function ExistWorkSheet(FEUILLE) As Boolean
'Principe : évalue la formule Feuille!A1 et vérifie si elle renvoie #REF
         ExistWorkSheet = Evaluate("ISREF('" & FEUILLE & "'!A1)")
End Function

Edit : Avec néanmoins quelques réserves sur l'intérêt d'un classeur de 200 onglets...
 
Dernière édition:

Etn

XLDnaute Occasionnel
Re : Macro pour afficher détail d'un TCD et renommer feuille générée

Bonsoir Chris,

C'est exactement ce que je recherche !

Et oui 200 onglets c'est énorme mais ce n'est pas pour une utilisation quotidienne du fichier mais juste une fois pour une analyse. (néanmoins le fichier est à généré plusieurs fois dans l'année et ta macro sera très utile !)

Sur ce, merci beaucoup et bonne soirée !
 

gillesH

XLDnaute Nouveau
Hello,

J'aimerais rebondir sur ce post. J'ai exactement la même problématique, mais au lieu de créer des nouveaux onglets renommé avec l'étiquette de ligne correspondante, j'aimerais que la macro enregistre un nouvelle feuille excel avec les données dans le même répertoire que mon fichier excel.

Est ce que quelqu'un pourrait m'aider ?

merci

Gilles
 

chris

XLDnaute Barbatruc
Bonjour

La commande ShowDetail génère forcément un nouvel onglet : il faut remplacer son renommage par sa copy dans un nouveau classeur puis le supprimer
VB:
Option Explicit
Sub Extraction()

Dim col1 As Integer, Lenom As PivotItem, Fichier As String

Application.ScreenUpdating = False
    With Worksheets("TCD").PivotTables(1)
        col1 = .DataBodyRange.Column
        'Extraction
        Application.DisplayAlerts = False
        For Each Lenom In .RowFields(1).PivotItems
            Lenom.DataRange.ShowDetail = True
            Fichier = ThisWorkbook.Path & "\" & Lenom & ".xlsx"
            ActiveSheet.Copy
            ActiveWorkbook.SaveAs Filename:=Fichier
            ActiveWorkbook.Close
            ActiveSheet.Delete
        Next Lenom
        Application.DisplayAlerts = True
       
    End With
Application.ScreenUpdating = True
End Sub
 
Dernière édition:

Discussions similaires

Réponses
15
Affichages
550

Statistiques des forums

Discussions
312 234
Messages
2 086 467
Membres
103 226
dernier inscrit
smail12