在VBA中復制數據透視表值

Question

我已經通過宏創建了數據透視表，並希望使用VBA將數據透視表復制為值。 創建數據透視表很順利，但是將其復制到另一張紙上讓我頭疼。 這是代碼：

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

該錯誤是Type mismatch錯誤。

Answer 1

嘗試下面的代碼，它有點“干凈”，我所做的修改是：

• 1）要復制數據透視表的數據並粘貼到另一個Worksheet作為值，您需要使用TableRange2而不是TableRange1 。
• 2）您已經很好地定義了pt對象並將其設置到PivotTable ，為什么不繼續使用它呢？ 在代碼中的任何shtTarget.PivotTables("PivotTable1")都可以用short pt替換shtTarget.PivotTables("PivotTable1") 。

代碼 （已測試）

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