Générer Fichier Excel à partir des Filtres d'un TCD

bonjour,

je dois à partir d'un TCD et suivant tous éléments qui sont ds un filtre générer des fichiers Excel séparés.

J'ai pensé utiliser la fonction "Afficher les pages du filtre du rapport" qui me crée autant d'onglet qu'il y a d'élément dans mon filtre choisi. Mais cela ne conserve pas la largeur des colonnes. Je dois donc à chaque fois appliquer COPIER/Collage spécial largeur colonne et cela sur autant d'onglet qu'il y a. Quand il y en a 2 ou 3 çà passe mais dès qu'il y en a un certain nombre c'est problématique.

Il y a également le fait que je suis obligé à chaque fois de refaire les formats d'impression à savoir Marge étroite et Ajuster le colonne à la page. Pour ENSUITE sauver fichier un a un sans me tromper.

Mon rêve serait que cela génère un fichier Excel qui reprend comme nom le nom du Filtre 1 que j'ai choisi "NC_M_09_16" concaténé à l'élément filtrant (Who) quand le Tableau contient des données. Dans mon exemple "PaaLa" tout en conservant mise en page, largeur colonne etc. Donc "NC_M_09_16_PaaLa". Le premier filtre "PaA" ne contenant pas de donnée ne doit pas généré un tableau...

Il y a également l'addition du TCD qui est HORS de mon tableau qui ne se recopie pas manuellement avec ma méthode décrite au dessus.... (D2 et E2) mais cela est accessoire.

Je joins mon fichier d'exemple. Ds onglet TCD Partner, j'ai filtré "NC relative au mois de" sur "NC_M_09_16". J'aimerais qu'il y ai autant de fichier créé par le principe expliqué au dessus chaque fois qu'un élément Who contient des données. Un peu comme les 3 derniers onglets que j'ai créé.

Il ne faut pas que les fichiers créés soient des TCD, seules les "valeurs" doivent être copiée et donc plus de filtre possible après.

Pensez-vous que cela soit réalisable? Par une manip simple, extension (j'avais pensé à Kutool mais ne fonctionne pas ds le cas d'un Pivot Table), VBA?

J'ai rendu "anonyme" les éléments figurants dans mon fichier exemple. Il faudra sans doute que j'adapte à mon fichier dont les noms des colonnes sont autres... Je n'y connais rien en VBA J'ai déjà vu ds le forum une question similaire mais ne remet plus la main dessus. D'où mon post pour que cela colle le mieux à mon exemple.

Merci à ceux qui pourront me faire avancer dans mes recherches.

Bien à vous.

Bonjour,

Un début de réponse à étudier.

A te relire.

Cdlt.

Option Explicit

Public Sub Create_Files()
Dim sPath As String, sFilename As String
Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet, wsPT As Worksheet
Dim pt As PivotTable
Dim pi As PivotItem
Dim rCell As Range

    Application.ScreenUpdating = False

    Set wb = ThisWorkbook
    sPath = wb.Path & Application.PathSeparator
    Set wsPT = wb.Worksheets("TCD Partner")
    Set pt = wsPT.PivotTables(1)

    pt.RefreshTable

    sFilename = pt.PageFields(1).DataRange.Value & " "

    For Each pi In pt.PageFields(2).PivotItems
        If pi.Name <> "" Then
            pt.PageFields(2).CurrentPage = pi.Name
            With pt.TableRange1
                Set rCell = .Cells(.Rows.Count, .Columns.Count)
            End With
            If rCell.Value <> "" Then
                Set wb2 = Workbooks.Add(xlWBATWorksheet)
                Set ws = wb2.Worksheets(1)
                ws.Name = pi.Name
                pt.TableRange2.Copy
                With ws.Cells(1)
                    .PasteSpecial xlPasteValuesAndNumberFormats
                    .PasteSpecial xlPasteFormats
                    .PasteSpecial xlPasteColumnWidths
                End With
                With Application
                    .CutCopyMode = False
                    .DisplayAlerts = False
                End With
                With wb2
                    .SaveAs Filename:=sPath & sFilename & pi.Name & ".xlsx"
                    .Close
                End With
                Application.DisplayAlerts = True
            End If
        End If
    Next pi

    Set rCell = Nothing
    Set pt = Nothing
    Set wsPT = Nothing
    Set wb2 = Nothing: setwb = Nothing

End Sub

Bonjour Jean-Eric,

Whouaaaaa Trop fort, cela fonctionne. MERCI:-)

J'ai juste mis un espace ici: "Set wb2 = Nothing: setwb = Nothing"->"Set wb2 = Nothing: set wb = Nothing"

Par contre le format d'impression "Marge étroite", "Colonne ajustée à la page" ne sont pas repris dans les fichiers créés.

Afin de sécuriser la création de fichier, serait il possible que le VBA me demande où enregistrer et surtout qu'il m'avertisse si un fichier existe déjà et me demande s'il peut écraser.

Enfin, possible de mettre le "_" pour que "NC_M_09_16 PaaLa" devienne "NC_M_09_16_PaaLa"

Quoi qu'il en soit, c'est déjà génial. Je vais déjà regarder si je sais adapter à mon fichier.

Edit; je viens de tester sur mon tableau. Ce que je fais c'est que j'ai mis la macro dans personal... il me dit comme erreur d'exécution 9. L'indice n'appartient pas à la sélection

Edit 2: Qd je mets la macro associé à mon fichier et donc pas dans personal.... alors là çà fonctionne. sans doute qu'il faut d'autre référence absolue ou relative dans le code si je veux mettre la macro dans personal....?

Ediit3: En plus des ajout "_" et recopie des propriétés de mise en page, où enregistrer, contrôle de fichier existant. Serait il possible aussi de généré le fichier avec comme filtre "(Tous)"? J'en demande beaucoup lol

RE,

Voir fichier modifié pour le nom de fichier et la mise en page des feuilles.

Pour le dernier point, à savoir l'enregistrement, ouvre un nouveau sujet, car je ne maîtrise pas vraiment la chose.

Cdlt.

nota : j'ai modifié pour un enregistrement dans PERSONAL.xlsb (à tester).

RE Jean-Eric,

Impeccable, cela fonctionne et cela dans mes macros Perso

Merci pour la correction avec le "_"

Merci pour la correction avec la mise en page C'est vrai que cela donne mieux en Paysage au passage Je vois que c'est fait avec un autre module non?

Pourriez-vous ajouter le fait qu'il capture le TCD avec le PIVOT (Tous) dans Who?

J'essaye de bidouiller dans la code pour y parvenir mais...

Bien à vous

RE,

Je ne comprends pas :

Pourriez-vous ajouter le fait qu'il capture le TCD avec le PIVOT (Tous) dans Who?

J'essaye de bidouiller dans la code pour y parvenir mais...

Re Jean-Eric,

Un peu comme si j'avais le filtrage "Tous" ds Who tel que remis dans le fichier annexe. Comme si tous les Who étaient dans le même tableau. Désolé j'ai du mal à m'expliquer.

Voir même pour le faire dans une NOUVELLE MACRO( je préférais). Car la macro que vous avez fait est TOP et me convient

Avec cette nouvelle macro, cela me créerait fichier genre "NC_M_09_16_Tous"... qui reprend aussi le principe de copie colonne, Format, Mise en page impression.

Est-ce que vous me comprenez?

RE,

Procédure Create_Files_02 à tester.

Cdlt.

Re,

c'est bien cela. A part qu'il me crée 3 fichiers dans ce cas présent au lieu de 1.

Si je sélectionne"NC_M_09_16" il ne devrait me faire qu'un seul fichier NC_M_09_16_Tous.xlxs

Si ce n'est pas possible, je supprimerai les fichiers que j'ai pas besoin mais je pense qu'un coup de modif ds le code n'aura pas de difficulté pour vous. Quand je vois tout ce que vous avez pu faire.

Si je pouvais coder comme vous.... Merci encore en tout cas.

RE,

Un nouvel essai.

Cdlt.

Jean-Eric,

MERCI MERCI MERCI MERCI MERCI

J'ai pu inclure dans mon fichier Personal. J'ai même pu ajouter une autre macro pour agir sur un autre de mes onglets en renommant le nom de l'onglet dans le code

Je suis vraiment content du résultat. C'était la partie la plus hardue pour moi dans mon process et grâce à vous c'est maintenant la partie que j'adore le plus Je me croise les bras et je souris en voyant les fichiers se créer.

Encore merci pour le temps consacré.

Bien à vous