Kopieren von PivotTable-Werten in VBA

Question

Ich habe eine Pivot-Tabelle über Makro erstellt und möchte die Pivot-Tabelle als Werte mithilfe von VBA kopieren. Das Erstellen einer Pivot-Tabelle lief gut, aber das Kopieren auf ein anderes Blatt bereitet mir Kopfschmerzen. Hier ist der 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 

Der Fehler ist ein Type mismatch Fehler.

Answer 1

den Code unten Versuchen Sie, es ist ein wenig „saubere“, die Modifikationen ich gemacht:

• 1) die Pivot-Tabelle der Daten zu kopieren und in einer anderen Worksheet einfügen als Werte, die Sie benötigen TableRange2 verwenden und nicht TableRange1.
• 2) Sie haben bereits Ihr Objekt pt so schön zu Ihrem PivotTable definiert und eingestellt, warum nicht weiter verwenden? Überall in Ihrem Code können Sie shtTarget.PivotTables("PivotTable1") mit einem kurzen pt ersetzt werden.

-Code (getestet)

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