Copie de valeurs de tableau croisé dynamique dans VBA

Question

J'ai créé un tableau croisé dynamique via macro et je souhaite copier le tableau croisé dynamique en tant que valeurs à l'aide de VBA. Créer un tableau croisé dynamique s'est bien passé, mais le copier sur une autre feuille me donne mal à la tête. Voici le code:

Sub test() 
Dim shtTarget, pvtSht As Worksheet 
Dim pc As PivotCache 
Dim pt As PivotTable 
Dim field As PivotField 
Dim rngSource As Range 

With ActiveWorkbook 
    Set rngSource = .Sheets(2).Range("H:I").CurrentRegion 
    Set shtTarget = .Sheets.Add(After:=.Sheets(.Sheets.count)) 
    shtTarget.Name = "Temp" 
    Set pc = .PivotCaches.Create(xlDatabase, rngSource, xlPivotTableVersion14) 
    Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable1", , xlPivotTableVersion14) 

End With 

With shtTarget.PivotTables("PivotTable1").PivotFields("Concatenate") 
    .Orientation = xlRowField 
    .Position = 1 
End With 

With shtTarget 
    .PivotTables("PivotTable1").AddDataField .PivotTables(_ 
    "PivotTable1").PivotFields("SCREEN_ENTRY_VALUE"), "Count of SCREEN_ENTRY_VALUE" _ 
    , xlSum 
End With 

With ActiveWorkbook 
    Set pvtSht = .Sheets.Add(After:=.Sheets(.Sheets.count)) 
    pvtSht.Name = "Sum of Element Entries" 

'==========================I'm stuck on this line================================= 

    .Sheets(shtTarget).PivotTables("PivotTable1").TableRange1.Copy 
    pvtSht.Range("A1").PasteSpecial xlPasteValues 
End With 

End Sub 

L'erreur est une erreur Type mismatch.

Answer 1

Essayez le code ci-dessous, il est un peu plus « propre », les modifications que j'ai fait:

• 1) Pour copier les données du tableau croisé dynamique et coller dans un autre Worksheet comme valeurs, vous devez utiliser TableRange2 et non TableRange1.
• 2) Vous avez déjà défini et défini votre objet pt si bien sur votre PivotTable, pourquoi ne pas continuer à l'utiliser? Partout dans votre code vous avez shtTarget.PivotTables("PivotTable1") peut être remplacé par un court pt.

code (testé)

Option Explicit 

Sub test() 

Dim shtTarget As Worksheet, pvtSht As Worksheet 
Dim pc As PivotCache 
Dim pt As PivotTable 
Dim field As PivotField 
Dim rngSource As Range 

With ActiveWorkbook 
    Set rngSource = .Sheets(2).Range("H:I").CurrentRegion 
    Set shtTarget = .Sheets.Add(After:=.Sheets(.Sheets.Count)) 
    shtTarget.Name = "Temp" 

    Set pc = .PivotCaches.Create(xlDatabase, rngSource, xlPivotTableVersion14) 
    Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable1", , xlPivotTableVersion14) 
End With 

With pt.PivotFields("Concatenate") 
    .Orientation = xlRowField 
    .Position = 1 
End With 

pt.AddDataField pt.PivotFields("SCREEN_ENTRY_VALUE"), "Sum of SCREEN_ENTRY_VALUE", xlSum 

With ActiveWorkbook 
    Set pvtSht = .Sheets.Add(After:=.Sheets(.Sheets.Count)) 
    pvtSht.Name = "Sum of Element Entries" 

    pt.TableRange2.Copy 
    pvtSht.Range("A1").PasteSpecial xlPasteValues 
End With 

End Sub