Automatisation de TCD

Bonjour à toute et a tous!

Dans le cadre de mon stage je réalise de nombreux TCD dont certains qui reviennent régulièrement et que je souhaite donc automatiser à l'aide de VBA.

Je suis novice dans ce langage. Pour vous donner une idée de mes tableaux je vous joins des données fictives!

Je souhaite avant tout comprendre le code pour me permettre de l'appliquer dans les différents cas qui se presentes.

Je vous remercie de votre aide et vous souhaite un bon week end!

Bonsoir,

J'ai posté un message comportant la création d'un TCD en VBA.

Consultes le et reviens vers moi si besoin.

Cdlt

https://forum.excel-pratique.com/excel/amelioration-et-optimisation-de-code-t40667-10.html

Merci de votre aide grace a la macro, la fonction enregistrer une macro et quelques heures de taff, j'ai pu comprendre la base et reussir à automatiser mes premiers TCD.

Encore merci de votre aide

Bonjour,

N'oublies pas de clore le sujet.

Cdlt.

En faite j'ai encore quelques petit questions

Pour faire les valeurs de mon TCD je procede ainsi pour mon code VB:

With ActiveSheet.PivotTables("TCD_1").PivotFields( _

" Libellé Produit") <-Correspond à ma colonne

.Caption = "Nombre de Libellé Produit" <-Correspond au nom dans mon TCD

.Orientation = xlColumnField <-précise que c'est une valeur et donc le met en colonne

.Function = xlCount <-Va realiser un nombre

.Position = 1 <-????? je sais pas ????

End With

Ma macro ne fonctionne pas sur la function pourquoi?

Cordialement

Bonne soirée!

Alex

Ps: le message d'erreur est le suivant:

Erreur d'execution '1004'

Impossible de définir la propriété Function de classe PivotField

Re,

Le problème est à la création du TCD ou lors de d'une modification d'un TCD existant?

Envoies ton code en entier ou ton fichier que je regarde.

Cdlt

Sub Macro2()
'
' Macro2 Macro
'
'
Dim wS As Worksheet
Dim Plage As Range, PTCache As PivotCache, PT As PivotTable
Dim p As PivotField

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    On Error Resume Next
        ActiveWorkbook.Worksheets("Résultat").Delete
    On Error GoTo 0

    Set wS = Worksheets(1)
    Set Plage = wS.Range("A1").CurrentRegion

    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
        SourceData:=Plage)

    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "Résultat"

    Set PT = PTCache.CreatePivotTable(TableDestination:=Worksheets("Résultat").Range("A1"), _
        TableName:="TCD_1")

    With ActiveSheet.PivotTables("TCD_1").PivotFields( _
        "Magasin")
        .Orientation = xlRowField
        .Position = 1
    End With

    With ActiveSheet.PivotTables("TCD_1").PivotFields("Test")
        .Orientation = xlPageField
        .Position = 1
    End With

    With ActiveSheet.PivotTables("TCD_1").PivotFields( _
        " volume")
       .Caption = "volume"
       .Orientation = xlColumnField
       .Function = xlCount
       .Position = 1
    End With

    With ActiveSheet.PivotTables("TCD_1").PivotFields( _
        "reduc")
        .Caption = "reduc"
        .Function = xlAverage
        .Orientation = xlColumnField
        .Position = 1
    End With

    With ActiveSheet.PivotTables("TCD_1").PivotFields( _
        "modificateur")
        .Caption = "modificateur"
        .Function = xlAverage
        .Orientation = xlColumnField
        .Position = 1
    End With

End Sub

Voici un exemple que j'ai adapté au fichier excel ci-dessus, je ne peux poster ici les données qui sont confidentielles, merci de votre aide.

Si ca peut en aider certains j'ai repondu a pas mal de mes questions ici:

Bonsoir,

A tester et à adapter...

Cdlt.

Option Explicit
Sub Macro2()
Dim wS As Worksheet
Dim Plage As Range, PTCache As PivotCache, PT As PivotTable
Dim p As PivotField

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    On Error Resume Next
        ActiveWorkbook.Worksheets("Résultat").Delete
    On Error GoTo 0

    Set wS = Worksheets(1)
    Set Plage = wS.Range("A1").CurrentRegion

    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
        SourceData:=Plage)

    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "Résultat"

    Set PT = PTCache.CreatePivotTable(TableDestination:=Worksheets("Résultat").Range("A1"), _
        TableName:="TCD_1")

    With PT
        .PivotFields("Test").Orientation = xlPageField
        .PivotFields("Magasin").Orientation = xlRowField
        End With
        With .PivotFields(" volume")
            '.Caption = "volume"
            .Orientation = xlColumnField
            .Function = xlCount
            .Position = 1
        End With
        With .PivotFields("reduc")
            '.Caption = "reduc"
            .Function = xlAverage
            .Orientation = xlColumnField
            .Position = 2
        End With
        With .PivotFields("modificateur")
            '.Caption = "modificateur"
            .Function = xlAverage
            .Orientation = xlColumnField
            .Position = 3
        End With
    End With

  Application.DisplayAlerts = True

End Sub

Merci encore pour ton aide qui m'a été d'une grande utilitée