Erreur Création TCD VBA

Bonjour,

J'utilisais une macro qui jusqu'alors marchait bien mais depuis quelque temps, j'ai un erreur d'incompatibilité de type. Voici le début du code ci dessous :

Sub TCDIKEA()
Application.DisplayAlerts = False
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
ActiveWorkbook.RefreshAll

'' Clermont

Worksheets("TCD Clermont").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "TCD Clermont"
Set PSheet = Worksheets("TCD Clermont")
Set DSheet = Worksheets("Clermont")
Set PRange = Sheets("Clermont").Range("A1").CurrentRegion
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange).CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), TableName:="TCD1")
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="TCD")

'Insert Row Fields
With ActiveSheet.PivotTables("TCD1").PivotFields("Nom SST")
.Orientation = xlRowField
.Position = 1
End With

With ActiveSheet.PivotTables("TCD1").PivotFields("Code ligne départ")
.Orientation = xlRowField
.Position = 2
End With

'Insert Column Fields
With ActiveSheet.PivotTables("TCD1").PivotFields("Date de départ (création du bordereau)")
.Orientation = xlColumnField
.Position = 1
End With

'Insert Data Field
With ActiveSheet.PivotTables("TCD1").PivotFields("Montant achat sous-traitance")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "#,##0"
.Name = "Montant"
End With

'Format
TableActiveSheet.PivotTables("TCD1").ShowTableStyleRowStripes = TrueActiveSheet.PivotTables("TCD1").TableStyle2 = "PivotStyleMedium9"

L'erreur arrive à la ligne qui débute par "Set PCache = ...". Je ne comprends pas bien d'où cela provient. Le fichier est actualisé toute les semaines, les PivotCaches et PivotTable sont donc déjà créés.

Est ce que quelqu'un peut m'aiguiller sur cette erreur?

Merci,

Bonjour Sothin,

Essayez de mettre l'instruction Debug.Print + Stop

Set DSheet = Worksheets("Clermont")
Set PRange = DSheet.Range("A1").CurrentRegion
' Ajout de l'instruction pour vérification
Debug.Print PRange.Address
Stop
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange).CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), TableName:="TCD1")

Voir ce que donne le résultat

A+

Bonjour Bruno,

Merci de votre réponse,

Voici le résultat du debug.print : $A$1:$K$2373

PRange prends donc bien la bonne plage de la feuille "Clermont".

L'erreur doit surement se situer sur la ligne PCache.

Je sais aussi que les Caches et Tables sont étroitement liés dans Excel, peut-être que je dois agir sur les tables plutôt que le cache?

Merci de votre aide,

Re,

Oui, mais sans fichier, c'est compliqué de savoir ce qui se passe

Voici le fichier en PJ. J'ai du rajouter des formules ALEA pour fausser les données qui sont confidentielles.

Mon code se situe dans le module 1, ce qui est dans le module 2 est simplement la pour m'aider dans la résolution de ce problème.

Bonsoir,
Pour commencer :

Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)
Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="TCD")

Cdlt.

Re,
Pour le fun !
Cdlt.

Option Explicit

Public Sub CreatePivotTables()
Dim wb As Workbook
Dim ws As Worksheet, wsData As Worksheet, wsPT As Worksheet
Dim arrSheets() As String
Dim lastCol As Long, lastRow As Long
Dim rngData As Range
Dim PTCache As PivotCache, PT As PivotTable
Dim i As Long

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Set wb = ActiveWorkbook

    For Each ws In wb.Worksheets
        If ws.PivotTables.Count > 0 Then ws.Delete
    Next ws

    Application.DisplayAlerts = False

    ReDim arrSheets(1 To wb.Worksheets.Count)
    For i = 1 To wb.Worksheets.Count
        arrSheets(i) = wb.Worksheets(i).Name
    Next i

    For i = LBound(arrSheets) To UBound(arrSheets)
        Set wsData = wb.Worksheets(i)
        With wsData
            lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
            Set rngData = .Cells(1).Resize(lastRow, lastCol)
        End With
        Set PTCache = wb.PivotCaches.Create(xlDatabase, rngData)
        Set wsPT = wb.Worksheets.Add(after:=wb.Worksheets(Worksheets.Count))
        wsPT.Name = "TCD " & wsData.Name
        Set PT = PTCache.CreatePivotTable(wsPT.Cells(3, 1), "TCD_" & wsData.Name)
        With PT
            .ManualUpdate = True
            .AddFields RowFields:=Array("Nom SST", "Code ligne départ"), ColumnFields:="Date de départ (création du bordereau)"
            With .PivotFields("Montant achat sous-traitance")
                .Orientation = xlDataField
                .Function = xlSum
                .NumberFormat = "#,##0"
                .Name = "Montant"
            End With
            .ShowTableStyleRowStripes = True
            .TableStyle2 = "PivotStyleMedium9"
            .ManualUpdate = False
        End With
    Next i

End Sub

Merci pour vos aides :)