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

尝试下面的代码，它有点＆＃34;清洁＆＃34; ，我做的修改：

1）要复制数据透视表的数据并粘贴其他Worksheet作为值，您需要使用TableRange2而不是TableRange1
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

在VBA中复制数据透视表值

1 个答案: