Sub CreerTCD()
 
'SourceData: Définit la source de données dans le TCD.
'[Feuil1!A1].CurrentRegion.Address(, , xlR1C1, True) permet d'étendre
'automatiquement la sélection de façon à y inclure toute la zone en cours
'à partir de la cellule A1, dans la Feuil1.
 
'TableDestination: Définit la position du TCD (cellule A3 dans la Feuil2).
 
'TableName: Définit le nom du nouveau TCD. ("Mon TCD")
 
ThisWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
    [Feuil1!A1].CurrentRegion.Address(, , xlR1C1, True)).CreatePivotTable _
    TableDestination:="Feuil2!R3C1", _
    TableName:="Mon TCD"
        
        
'Mise en forme:
With Feuil2.PivotTables("Mon TCD")
    'Ajoute un champ de lignes nommé "Ville".
    'Le nom du champ "Ville" doit préalablement exister comme entête de la
    'source de données.
    .AddFields RowFields:="Ville"
    'Définit l'orientation du champ nommé "CA" en tant que Donnée.
    'le nom du champ "CA" doit préalablement exister comme entête
    'de la source de données.
    .PivotFields("CA").Orientation = xlDataField
End With
 
End Sub

Sub AppliquerFonctionTCD()
 
Feuil2.PivotTables("Mon TCD").PivotFields("Somme de CA").Function = xlAverage
 
'Les autres constantes disponibles pour la propriété Function:
'xlAverage - Moyenne
'xlCountNums - Nb
'xlMin - Min
'xlStDev - Ecartype
'xlSum - Somme
'xlVar - Var
'xlCount - Nombre
'xlMax - Max
'xlProduct - Produit
'xlStDevP - Ecartypep
'xlUnknown - 
'xlVarP - Varp
 
End Sub

Sub requeteTCD()
    Dim Pvt As PivotTable
    
    'Définit le TCD dans la feuille
    Set Pvt = Worksheets("Résultats").PivotTables("Tableau croisé dynamique1")
    
    'Renvoie la valeur 'Somme ca 2002', pour le champ 'reference' égal à 35
    MsgBox Pvt.GetData("'Somme ca 2002' 'reference' '35'")
End Sub

Sub compterNombreLignesTCD()
    Dim Pvt As PivotTable

    'Définit le TCD    
    Set Pvt = Worksheets("Feuil1").PivotTables("Tableau croisé dynamique1")
    
    'TableRange1:
    'plage contenant l'intégralité du rapport de tableau croisé dynamique,
    'à l'exclusion des champs de page.
    MsgBox Pvt.TableRange1.Rows.Count
    
    'TableRange2 :
    'plage contenant l'intégralité du rapport de tableau croisé dynamique,
    'y compris les champs de page.
    MsgBox Pvt.TableRange2.Rows.Count
End Sub

Sub CreationTCD_MultiPage()
    'Testé sous Excel 2007
    Dim NomFeuille As String
    Dim i As Integer
    Dim RefPlage As String, Cible As String
    Dim Tableau() As String
    Dim ListeFeuilles As Variant
    
    Application.ScreenUpdating = False
    
    'Liste de feuilles contenant les données.
    'Pour cet exemple, les données sont dans la plage A1:B6 de chaque feuille (en-tête compris).
    ListeFeuilles = Array("Feuil1", "Feuil2", "Feuil3")
    
    'Définit la taille du tableau pour stocker l'adresse des sources
    'de données.
    ReDim Preserve Tableau(1 To UBound(ListeFeuilles) + 1, 1 To 2)
    
    'Boucle sur le nom des feuilles pour créer la référence des sources
    'Style: Feuil1!R1C1:R6C2, Feuil2!R1C1:R6C2 ... etc ...
    For i = LBound(ListeFeuilles) To UBound(ListeFeuilles)
        NomFeuille = ListeFeuilles(i)
        RefPlage = Range("A1:B6").Address(ReferenceStyle:=xlR1C1, _
            RowAbsolute:=True, ColumnAbsolute:=True)
        Cible = NomFeuille & "!" & RefPlage
        Tableau(i + 1, 1) = Cible
        Tableau(i + 1, 2) = ListeFeuilles(i)
    Next i
    
    'Crée le TCD dans la cellule A1 de la feuille "Synthese"
    ThisWorkbook.PivotCaches.Add(SourceType:=xlConsolidation, _
        SourceData:=Tableau).CreatePivotTable _
        TableDestination:=Worksheets("Synthese").Range("A1"), _
        TableName:="PivotTable1"
    
    
    Worksheets("Synthese").Activate
    'Mise en forme du TCD
    With ActiveSheet.PivotTables("PivotTable1")
        .ColumnGrand = False
        .HasAutoFormat = False
        .RowGrand = False
        .SmallGrid = False
        .PivotFields(1).PivotItems(1).Position = 1
    End With
    
    Application.ScreenUpdating = True
    
End Sub

Option Explicit
Option Compare Text

Sub SourceTCD_Ref_xlA1_FR()
    Dim Pvt As PivotTable
    Dim Cible As String, NomFeuille As String
    
    'Définit le premier TCD de la feuille active.
    Set Pvt = ActiveSheet.PivotTables(1)
    
    'Extrait le nom de la feuille
    NomFeuille = Left(Pvt.SourceData, InStr(1, Pvt.SourceData, "!") - 1)
    
    'Pour gérer la version française d'Excel et remplacer le format xlL1C1 en xlR1C1.
    Cible = Replace(Mid(Pvt.SourceData, Len(NomFeuille) + 2), "L", "R")
    
    MsgBox NomFeuille & "!" & Replace(Application.ConvertFormula( _
                Formula:=Cible, _
                fromReferenceStyle:=xlR1C1, _
                toReferenceStyle:=xlA1, _
                toAbsolute:=xlAbsolute), _
                "[" & ThisWorkbook.Name & "]", "")
End Sub

Sub SourceTCD_Ref_xlA1_EN()
    Dim Pvt As PivotTable
    Dim Cible As String
    
    'Définit le premier TCD de la feuille active.
    Set Pvt = ActiveSheet.PivotTables(1)
    
    Cible = Pvt.SourceData
    
    MsgBox Replace(Application.ConvertFormula( _
                Formula:=Cible, _
                fromReferenceStyle:=xlR1C1, _
                toReferenceStyle:=xlA1, _
                toAbsolute:=xlAbsolute), _
                "[" & ThisWorkbook.Name & "]", "")
End Sub

'--- Dans un module standard ---
Option Explicit
 
Public Tableau As Variant
'---

'--- Dans le module objet ThisWorkbook ---
 
Option Explicit
 
Private Sub Workbook_Open()
    Dim Pvt As PivotTable
    
    'Le TCD est dans la Feuil4
    Set Pvt = Worksheets("Feuil4").PivotTables("Tableau croisé dynamique1")
 
    Tableau = Pvt.TableRange1.Value
End Sub
'---

'--- Dans le module objet de la feuille contenant le TCD ---
Option Explicit
Option Base 1

'L'évènement est déclenché à chaque mise à jour du TCD
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    Dim Cell As Range
    Dim i As Long
    Dim j As Integer
    
    i = Target.TableRange1.Cells(1, 1).Row - 1
    j = Target.TableRange1.Cells(1, 1).Column - 1
    
    'Vérifie si un champ ou une étiquette a été ajouté ou supprimé
    If UBound(Tableau, 2) <> Target.TableRange1.Columns.Count Or _
            UBound(Tableau, 1) <> Target.TableRange1.Rows.Count Then
        
        Erase Tableau
        Tableau = Target.TableRange1.Value
        
        'Tout le TCD change de couleur lorsqu'un champ ou une étiquette
        'est supprimé ou ajouté.
        Target.TableRange1.Cells.Interior.ColorIndex = 4
        
        Exit Sub
    End If
    
    'Boucle sur les cellules du rapport pour comparer le contenu du tableau et du TCD
    For Each Cell In Target.TableRange1
        'Si la donnée a été modifiée
        If Cell.Value <> Tableau(Cell.Row - i, Cell.Column - j) Then
            'Personnalise la couleur de la cellule
            Cell.Interior.ColorIndex = 4
            Else
            Cell.Interior.ColorIndex = 9
        End If
    Next Cell
    
    'Efface le contenu du tableau
    Erase Tableau
    'Stocke les nouvelles données dans le tableau
    Tableau = Target.TableRange1.Value
End Sub
'----

'Auteur: Debra Dalgleish
Dim PvT As PivotTable
Dim PvF As PivotField

On Error Resume Next
For Each PvT In ActiveSheet.PivotTables
    For Each PvF In PvT.PivotFields
        PvF.Subtotals(1) = True
        PvF.Subtotals(1) = False
    Next PvF
Next PvT