Créer une Macro pour TCD

Bonjour,

Tout d'abord, désolé si mon sujet fait doublon.

Afin d'économiser du temps, j'aimerais développer une macro qui automatise la création et la configuration d'un Tableau Croisé Dynamique.

J'ai bien essayé mais à chaque fois, j'ai le même message d'erreur :

Quand je vais voir le code, j'observe ceci :

Si quelqu'un pouvait m'expliquer où je pêche, ou bien m'orienter vers une partie du forum traitant déjà de ce sujet.

Merci.

Bonjour

C'est une mauvaise idée

Sachant que l'on peut modifier la source d'un TCD, on déconseille de coder pour les construire.

Par ailleurs c'est un non sens de bâtir un TCD sur des colonnes entières : depuis plus de 20 ans la source des TCD est le tableau structuré et avant on utilisait des plages dynamiques nommées...

Bonjour,
Une petite contribution !...
Un petit fichier ?
Cdlt.

Option Explicit

Public Sub CreatePivotTable()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim rngData As Range
Dim PTCache As PivotCache, PT As PivotTable, pf As PivotField, pi As PivotItem

    Application.ScreenUpdating = False

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets("1")
    Set rngData = wsData.Cells(1).CurrentRegion
    Set wsPT = wb.Worksheets("Export Matinal")

    On Error Resume Next
    wsPT.PivotTables("TCD_1").TableRange2.Clear
    On Error GoTo 0

    Set PTCache = wb.PivotCaches.Create(xlDatabase, rngData)
    PTCache.MissingItemsLimit = xlMissingItemsNone

    Set PT = PTCache.CreatePivotTable(wsPT.Cells(4, 2), "TCD_1")

    With PT
        .ManualUpdate = True
        .AddFields RowFields:=Array("Site", "Tournée")
        For Each pf In PT.PivotFields
            pf.Subtotals(1) = True
            pf.Subtotals(1) = False
        Next pf
        .ManualUpdate = False
        .ManualUpdate = True
        For Each pf In .PivotFields
            For Each pi In pf.PivotItems
                pi.Visible = pi.Name <> "(blank)"
            Next pi
        Next pf
        .ColumnGrand = False
        .ManualUpdate = False
    End With

    'memory
    Set PT = Nothing: Set PTCache = Nothing
    Set rngData = Nothing
    Set wsPT = Nothing: Set wsData = Nothing
    Set wb = Nothing

End Sub

Désolé pour ma réponse tardive mais merci beaucoup pour la contribution !!!

Pour aller, un peu plus loin, j'aurais besoin de voir en valeur le nombre d'objets. J'ai pas encore le niveau pour le faire moi-même. J'ai complété le fichier que tu m'as envoyé pour rendre cela faisable.

Bonjour,
Une mise à jour.
A te relire.
Cdlt.

Option Explicit

Public Sub CreatePivotTable()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim rngData As Range
Dim PTCache As PivotCache, PT As PivotTable, pf As PivotField, pi As PivotItem

    Application.ScreenUpdating = False

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets("1")
    Set rngData = wsData.Cells(1).CurrentRegion
    Set wsPT = wb.Worksheets("Export Matinal")

    On Error Resume Next
    wsPT.PivotTables("TCD_1").TableRange2.Clear
    On Error GoTo 0

    Set PTCache = wb.PivotCaches.Create(xlDatabase, rngData)
    PTCache.MissingItemsLimit = xlMissingItemsNone

    Set PT = PTCache.CreatePivotTable(wsPT.Cells(4, 2), "TCD_1")

    With PT
        .ManualUpdate = True
        .AddFields RowFields:=Array("Site", "Tournée")
            With .PivotFields("N°d'Objets")
                .Orientation = xlDataField
                .Function = xlCount
                .Caption = "Nb. Objets"
            End With
        For Each pf In PT.PivotFields
            pf.Subtotals(1) = True
            pf.Subtotals(1) = False
        Next pf
        .ManualUpdate = False
        .ManualUpdate = True
        For Each pf In .PivotFields
            For Each pi In pf.PivotItems
                pi.Visible = pi.Name <> "(blank)"
            Next pi
        Next pf
        .ColumnGrand = True
        .ManualUpdate = False
    End With

    'memory
    Set PT = Nothing: Set PTCache = Nothing
    Set rngData = Nothing
    Set wsPT = Nothing: Set wsData = Nothing
    Set wb = Nothing

End Sub

Merci beaucoup pour la réponse. Je teste ça, en configuration complète et vous tiens au courant.

Encore merci

Yes !!!

Encore merci beaucoup.

J'y suis allé au feeling mais j'ai réussi à paramétrer pratiquement à 100% comme je le voulais mon fichier.

Un seul problème demeure.

J'ai l'impression que le code ci-dessous, ne permet pas d'aller chercher des titres de colonnes (en gras) supérieurs à un mot.

.AddFields RowFields:=Array("Site", "Tournée")

Je mets en PJ le type de titres de colonnes auxquels je suis confronté.

Après ça, je pense avoir atteint mon objectif.

Re,
Les en-têtes de colonnes (titres) doivent être saisis sans caractères spéciaux ( car(10) ; retour chariot).
Sinon, ne peux-tu pas mettre tes données sous forme de tableau structuré ?
Cdlt.

Bon, je me suis réjoui trop vite.

J'ai réussi à utiliser le code que tu m'as fourni @Jean-Eric. Il fonctionne pour 11/12 des TCD que je veux créer. Il plante pour le n°5 sans que je sache pourquoi. Le plantage interrompt les autres TCD, mais quand je supprime l'occurrence n°5, les suivantes se créent sans problème. J'ai essayé beaucoup de techniques mais rien n'y a fait.

Si tu avais encore un peu de ton temps à me consacrer...

Concernant les titres de colonnes : j'ai trouvé une solution en les fixant sur les pages 1, 2, 3, .... Je copie/colle des tables de données sans les en-têtes.

Bonjour,
Sans voir de données, difficile d'apporter une aide !
Cdlt.

@Jean-Eric,

J'ai nettoyé, un peu mon code et depuis toutes les Macro fonctionnent !!!

Je te remercie pour ton aide précieuse et le gain de temps que cela va générer.

Vive l'amélioration continue !!!

Existe-t-il du code pour passer de l'Etat1 à l'Etat2 ?

J'ai essayé au préalable de le trouver moi-même en enregistrant une macro mais sans succès.

Voir fichier ci-joint

Après quelques essais/échecs, j'ai réussi à produire du code pour ma précédente question.

Le temps me dira si cela est stable. J'ai un doute car tous les sites ont eu des occurrences mais ce n'est pas le cas tous les jours. La macro fonctionnera-t-elle, alors ?

Bonjour,
Une petite mise à jour.
Cdlt.

Option Explicit

Public Sub CreatePivotTable()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim rngData As Range
Dim PTCache As PivotCache, PT As PivotTable, pf As PivotField, pi As PivotItem

    Application.ScreenUpdating = False

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets("Data")
    Set rngData = wsData.Cells(1).CurrentRegion
    Set wsPT = wb.Worksheets("PT")

    On Error Resume Next
    wsPT.PivotTables("PT_1").TableRange2.Clear
    On Error GoTo 0

    Set PTCache = wb.PivotCaches.Create(xlDatabase, rngData)
    PTCache.MissingItemsLimit = xlMissingItemsNone

    Set PT = PTCache.CreatePivotTable(wsPT.Cells(4, 2), "PT_1")

    With PT
        .ManualUpdate = True
        .AddFields RowFields:=Array("Site", "Tournée")
            With .PivotFields("N° d'Objet")
                .Orientation = xlDataField
                .Function = xlCount
                .Caption = "Nb. Objets"
            End With
        For Each pf In PT.PivotFields
            pf.Subtotals(1) = True
            pf.Subtotals(1) = False
        Next pf
        .RowAxisLayout xlOutlineRow ' new
        .PivotFields("Site").ShowDetail = False ' new
        .ManualUpdate = False
        .ManualUpdate = True
        For Each pf In .PivotFields
            For Each pi In pf.PivotItems
                pi.Visible = pi.Name <> "(blank)"
            Next pi
        Next pf
        .ColumnGrand = True
        .ManualUpdate = False
    End With

    With wsPT
        .Activate
        .Cells(1).Select
    End With

    'memory
    Set PT = Nothing: Set PTCache = Nothing
    Set rngData = Nothing
    Set wsPT = Nothing: Set wsData = Nothing
    Set wb = Nothing

End Sub