MACRO création TCD ne fonctionne plus?

Bonjour,

Afin de ne pas alourdir un classeur, crée avec une version 2003 (ou ultérieure) d'excel, est exécuté en mode de compatibilité sous 2010 j'ai réalisé depuis plusieurs années diverses Macro créant automatiquement différents TCD.

Les macros tirent leur données source de deux onglets (macro distinctes) et créent le tableau sur un onglet vide nommé TCD.

Les codes suivant les données les données sources sont identiques.

Mais depuis peu pour les macro d'un des deux onglets (les macro de l'autre onglet sont toujours opérationnelles) ne fonctionnement plus...

"Erreur d'exécution 13" incompatibilité de type

J'ai déjà essayé ceci:

* Supprimer les colonnes et lignes vides "hors plage du tableau"

* Supprimer les données des 2 mois précédents (macro étaient opérationnelles)

Rien n'y change?

J'ai déjà eu un soucis comparable (mise à jour windows?)

J'ai également copier le code (modèle identique) de l'onglet ou les macros de créations TCD fonctionne et adapté les noms et plage à l'onglet qui pause problème... rien n'y fait, toujours la même erreur???

En fait ce code créer automatiquement à la demande un TCD sur un onglet vierge du classeur, TCD qui est supprimer après la consultation. N'existe t'il pas un code plus "light" pour créer un TCD sur lequel je copierais les choix de variables et champs de lignes existant?

Voici le code utilisé en copie: c'est la ligne "Set pc" qui bloque, si une bonne ame à une idée, mi je bloque

Merci

Sub XMA_Kilos()

'

' XMA_Kilos Macro

'

' Touche de raccourci du clavier: Ctrl+k

'

Dim ws As Worksheet, pc As PivotCache, TCD As PivotTable

Application.ScreenUpdating = False

Set ws = Sheets("TCD")

With ws

If .PivotTables.Count > 0 Then

.PivotTables(1).TableRange2.Delete

End If

End With

With Sheets("Transport")

Set pc = ThisWorkbook.PivotCaches.Add(xlDatabase, .Range("A1:AP" & .Range("A65536").End(xlUp).Row))

End With

Set TCD = pc.CreatePivotTable(ws.Range("A5"))

With TCD

.PivotFields("Mois").Orientation = xlRowField

.PivotFields("Année").Orientation = xlColumnField

.PivotFields("Fournisseur").Orientation = xlPageField

.PivotFields("Où").Orientation = xlPageField

.PivotFields("Espèce").Orientation = xlPageField

.RowGrand = False

.ColumnGrand = True

With .PivotFields("Kilo")

.Caption = "Kilos"

.Orientation = xlDataField

.Function = xlSum

.NumberFormat = "#,##; [Red]-#,##"

End With

End With

Sheets("TCD").Select

Range("E1").Select

End Sub

Bonjour,

A tester.

Option Explicit
Public Sub XMA_Kilos()
' Touche de raccourci du clavier: Ctrl+k
Dim wsd As Worksheet, wss As Worksheet
Dim rng As Range
Dim pc As PivotCache
Dim pt As PivotTable

    Application.ScreenUpdating = False

    Set wsd = Worksheets("TCD")
    Set wss = Worksheets("Transport")

    For Each pt In wsd.PivotTables
        pt.TableRange2.Clear
    Next pt

    Set rng = wss.Range("A1").CurrentRegion
    Set pc = _
        ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=rng.Address)
    Set pt = _
        pc.CreatePivotTable(TableDestination:=wsd.Range("A5"), _
        TableName:="TCD1")

    pt.AddFields _
        RowFields:="Mois", _
        ColumnFields:="Année", _
        PageFields:=Array("Fournisseur", "Où", "Espèces")

    With pt.PivotFields("Kilo")
        .Caption = "Kilos"
        .Orientation = xlDataField
        .Function = xlSum
        .NumberFormat = "#,##; [Red]-#,##"
    End With

    pt.RowGrand = False
    pt.ColumnGrand = True

    Sheets("TCD").Select
    Range("E1").Select

    Set wsd = Nothing: Set wss = Nothing: Set rng = Nothing

End Sub

Bonjour,

Ce bug un peu plus loin à présent:

Au niveau des 4 lignes suivantes

pt.AddFields _

RowFields:="Mois", _

ColumnFields:="Année", _

PageFields:=Array("Fournisseur", "Où", "Espèces")

Merci de votre aide

Re,

Je peu t'envoyer le fichier par MP (donnée un peu sensibles) 8)

Ok