vba - 在 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

该错误是一个类型不匹配错误。

Answer 1

尝试下面的代码，它有点“干净”，我所做的修改:

• 1) 要复制数据透视表的数据并将其作为值粘贴到另一个 Worksheet 中，您需要使用 TableRange2 而不是 表范围1。
• 2) 您已经定义了 pt 对象并将其很好地设置到 PivotTable 中，为什么不继续使用它呢？代码中任何地方的 shtTarget.PivotTables("PivotTable1") 都可以替换为短的 pt。

代码(已测试)

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