Macros sur TCD

[aminedu92]

Bonjour à tous,
voici mon petit problème :
J'ai un TCD avec un champ pages (= Julie, Cédric, ...)

je veux une macro qui me permette d'un seul clic de créer un fichier excel avec en feuille 1 le détail des données pour ce champ de pages.
Le fichier excel joint sera plus parlant je pense.

S'il y a un moyen sans macro, je suis aussi preneur 🙄

Merci d'avance à vous,
ce forum m'a aidé tant de fois.

 

[CB60]

Re : Macros sur TCD

Bonsoir
Pourquoi ne pas garder le TCD existant, avec une adaptation d'une macro de DEBRA DALGLEISH, j'ai mis une liste déroulante en D1 lorsque tu selectionne un nom, le TCD se met à jour ainsi que le nom de la feuille.
Cela permet de ne pas surcharger ton classeur

edit bonsoir Bhbh

 

[Cousinhub]

Re : Macros sur TCD

Bonjour,

essaie ce code :

Sub fichier_par_nom()
Application.ScreenUpdating = False
LeDir = ThisWorkbook.Path & "\"
With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Délégué d'Opération")
    For Each PvI In .PivotItems
        .CurrentPage = "" & PvI & ""
        Sheets("TCD").Copy
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs LeDir & PvI & ".xls"
        ActiveWorkbook.Close
    Next PvI
    .CurrentPage = "(Tous)"
End With
End Sub

Edit : Bonsoir, Bruno
Edit 2 : modif pour alléger le code

 

[aminedu92]

Re : Macros sur TCD

Bonjour,

essaie ce code :

Sub fichier_par_nom()
Application.ScreenUpdating = False
LeDir = ThisWorkbook.Path & "\"
With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Délégué d'Opération")
    For Each PvI In .PivotItems
        .CurrentPage = "" & PvI & ""
        Sheets("TCD").Copy
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs LeDir & PvI & ".xls"
        ActiveWorkbook.Close
    Next PvI
    .CurrentPage = "(Tous)"
End With
End Sub

Edit : Bonsoir, Bruno
Edit 2 : modif pour alléger le code

merci à toi mais ça ne marche pas, cela m'affiche "l'indice n'appartient pas à la selection"😕
sinon je viens de voir dans la barre d'outils Tableau croisé Dynamique, la fonction afficher les pages🙄. quand on se positionne sur un champ et que l'on clique sur cette fonction, cela génère une page par champ dans le classeur,
c'est presque ce que je cherchais 😛(moi je voulais autant de classeur que de champ de page), mais bon je trouve que c'est déjà pas mal.
Maintenant je déplace chaque nouvelle feuille dans un classeur vierge, de façon manuelle🙄

 

[Cousinhub]

Re : Macros sur TCD

Bonsoir,

si tu as ce message d'erreur, c'est que le nom du TCD, n'est pas "Tableau croisé dynamique1", mais qu'il porte un autre nom, ou que le nom de l'onglet n'est pas le bon, ou que le nom du champ n'est pas "Délégué d'Opération"....

Bonne soirée

 

[bcharef]

Re : Macros sur TCD

bonjour aminedu92,
la solution de votre probléme est la suivante :
cliquer sur tableau croisé dynamique de la barre d'outils Tableau croisé dynamique puis
cliquer afficher les pages
une boite de dialogue s'affiche
cliquer sur ok
puis les feuilles s'affichent automatiquement portant le nom de chacun délégué d'opération
Espérant bien que j'ai répondu à ton probléme

 

[MJ13]

Re : Macros sur TCD

Bonjour à tous,

Voici une macro a tester
Attention il faut avoir le nom du filtre en A1 (comme dans le fichier du premier post).

Sinon la solution de Becharef est intéressante (encore une que je ne connaissais pas mais les possibiltés des TCDS sont énormes). Seul souci est que l'on obtient de nouveaux tableaux croisés (a voir si la mémoire ne s'en trouve pas trop augmenter)

Sub Copy_TCD_Feuilles()
' Macro enregistrée le 19/09/2008 par MJ
'Stop
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields(Cells(1, 1).Value)
    nfiltreext = .PivotItems.Count
    For ifiltreextcommune = 1 To nfiltreext ' - 1
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields(Cells(1, 1).Value). _
        CurrentPage = .PivotItems(ifiltreextcommune).Value
        ajoute_copy_feuille
    Next ifiltreextcommune
        End With
Cells(1, 1).Select
End Sub
Sub ajoute_copy_feuille()
' Macro enregistrée le 19/09/2008 par MJ
    Cells.Select
    Range("B2").Activate
    Selection.Copy
    Sheets.Add
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets(ActiveSheet.Name).Name = Cells(1, 2).Value
    Range("A1").Select
    ActiveSheet.Next.Select
    Application.CutCopyMode = False
End Sub