将数据透视表值复制到新的工作表vba

时间:2019-02-18 21:08:13

标签: excel vba

我正在尝试使用VBA将数据透视表值复制到新工作表中。我遇到运行时错误5。这是我的代码

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
    Dim wb As Workbook: Set wb = ThisWorkbook

    With wb
        Set rngSource = .Sheets(2).Range("A5").CurrentRegion
        Set shtTarget = .Sheets.Add(After:=.Sheets(.Sheets.Count))

        Set pc = .PivotCaches.Create(xlDatabase, rngSource.Address(False, False, xlA1, xlExternal))
Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable3", , 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 wb
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

我的数据透视表的范围是A5:I266。设置pt = pc.CreatePivotTable ...上出现代码错误...

1 个答案:

答案 0 :(得分:0)

替换:

Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable3", , xlPivotTableVersion14)

具有:

Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable3")