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