Macro VBA pour créer des tables triés à partir d'un TCD

Bonjour tout le monde,

j'ai un travail à réaliser à partir d'un tableau croisé dynamique qui dresse le coût de produits par fournisseur (onglet "table" du fichier joint), le TCD est filtré par région.
le TCD est composé de deux colonnes fixes (code fournisseur et son nom) et autant de colonnes qu'il y a de produits. l'objectif est d'arriver à quelque chose semblable de l'onglet (75-Paris). Donc grosso-modo le macro doit:

- créer un onglet par région et dans chaque onglet créer des tables séparés et triés par ordre croissant du coût avec trois colonnes chacun selon la structure suivante: Code fournisseur, nom fournisseur, produit1, colonne vide, Code fournisseur, nom fournisseur, produit2, colonne vide,Code fournisseur, nom fournisseur, produit3 et ainsi de suite..et cela pour chaque région.
le fichier joint n'est qu'un modèl avec des données fictives pour illustrer le cas et donc primordiale que le point de départ soit le TCD au lieu de fichier de données dont l'onglet est caché car de toute façon le fichier de données réelles comporte une centaines de régions, de produits et de fournisseurs et donc impossible d'y arriver manuellement.

Merci à tous qui vont m'aider ou pensent à m'aider..vous êtes tous géniaux.

Bonjour,

Une solution plus simple consisterait à dupliquer sur votre onglet Table votre TCD, autant de fois que de produits et n'en sélectionner qu'un chaque fois comme dans le vidage d'écran ci-dessous.

Puis de créer le segment Région. La sélection d'une région dans le segment mettra tous les TCD à jour.

re,

avec une macro assez courte, mais que faut-il faire si la feuille "75-Paris" existe déjà, supprimer et créer une nouvelle ?

Eric Kergresse
ta solution est correcte sauf que avec le nombre de produits que j'ai en réalité et les fiches que je dois produire par région.. c'est difficile a y arriver

BsAlv
la feuille "75-Paris" est donné à titre d'exemple. Donc à supprimer. avec le fichier réelle il n'ya que le TCD et la feuilles de données qui l'alimente.

Merci pour vos efforts, c'est ben apprécié!

Edit : "ta solution est correcte sauf que avec le nombre de produits que j'ai en réalité et les fiches que je dois produire par région.. c'est difficile a y arriver"

Je ne vois pas bien la raison.

Sinon, s'il faut autant d'onglets que de régions, il suffit de dupliquer le TCD et de les régler une fois pour toute sur les bonnes régions.

bonjour,

Sub Kasper()
     Dim SH, PVT, i

    Application.ScreenUpdating = False
    't = Timer
    Application.DisplayAlerts = False
     For Each SH In ThisWorkbook.Worksheets
          If SH.Name Like "## - [A-Z]*" Then SH.Delete     'supprimer toutes les feuilles existantes nommée "## - ..."
     Next
     Application.DisplayAlerts = True

     Set PVT = Sheets("Table").PivotTables("Tableau croisé dynamique1")
     With PVT
          .PivotFields("région").ClearAllFilters     'supprimer les filtres sur Région
          .PivotFields("code produit").ClearAllFilters     'et code produit
          For Each it In .PivotFields("région").PivotItems     'boucle les régions
               .PivotFields("région").CurrentPage = it.Name     'filtre une région
               Application.StatusBar = it.Name: DoEvents 'voir le progrès = inutile et freine un petit peut la macro (!!!)
               Set c = .TableRange1          'cette plage du TCD
               Sheets.Add After:=Sheets(ThisWorkbook.Sheets.Count)     'ajouter une nouvelle feuille
               With ActiveSheet              'avec cette feuille
                    .Name = it.Name          'son nom
                    PVT.PageRange.Copy .Range("A1")     'pagerange du TCD
                    For i = 1 To c.Columns.Count - 2     'boucle les produits
                         Set c1 = .Cells(3, (i - 1) * 4 + 1)     'coin en haut et à gauche pour coller
                         c.Resize(, 2).Copy c1     'les 2 premières colonnes
                         c.Resize(, 1).Offset(, i + 1).Copy c1.Offset(, 2)     'colonne produit
                         c1.CurrentRegion.EntireColumn.AutoFit     'ajuster largeur
                         c1.CurrentRegion.Offset(1).Sort c1.Cells(2, 3), Header:=xlYes     'trier
                    Next
               End With
          Next
       Application.StatusBar = "": DoEvents
           .PivotFields("région").ClearAllFilters     'supprimer les filtres sur Région
          Application.Goto .Parent.Range("A1")
     End With

     MsgBox "prêt " '& Format(Timer - t, "0.00\s")
End Sub

en ajoutant un ' oubien REM en face de la ligne "c1.CurrentRegion.EntireColumn.AutoFit 'ajuster largeur", le largeur ne sera pas ajusté, peut-être que vous préférez cela.

Salut BsAlv,

Ta proposition est géniale Bro!

Merci infiniment, Problème résolu!

Bonjour BsAlv,
est ce que si possible de modifier le code pour ajouter à chaque tableau généré une colonne pour désigner le rang (ordre croissant de 1 jusqu'à la dernière ligne de chaque tableau )?

bonjour, comme demandé ...

Woooooooooooooooooooow. Merci beaucoup!