Question

我正在尝试将数据透视表复制到现有工作表中。
我已成功将以前的数据透视表复制到此工作表，这导致我在复制第二个数据透视表时遇到问题。

当前错误消息是：

运行时错误'1004'：应用程序定义或对象定义的错误。

我想将数据透视表粘贴到单元格D64中，因为该单元格下面和右边的单元格都清晰可见。我现有的数据透视表位于单元格A64：B36中。

有人可以帮我弄清楚我在做什么错吗？

Sub ObsoPivotCopy
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim Prange As Range
Dim lastRow As Long
Dim lastCol As Long

Set PSheet = Worksheets("1188 MJ Summary")
Set DSheet = Worksheets("ObsoCopy")

'Define Data Range
lastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set Prange = DSheet.Cells(1, 1).Resize(lastRow, lastCol)

'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=Prange). _
CreatePivotTable(TableDestination:=PSheet.Cells(200, 200), _
TableName:="ObsoPivot")

'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(200, 200), TableName:="ObsoPivot")

'Insert Data Fields
ActiveSheet.PivotTables("ObsoPivot").AddDataField ActiveSheet.PivotTables( _
        "ObsoPivot").PivotFields("MARGIN â‚¬"), "Sum of MARGIN â‚¬", xlSum
    ActiveWindow.SmallScroll Down:=21
    ActiveSheet.PivotTables("ObsoPivot").PivotFields("Sum of MARGIN â‚¬"). _
        Orientation = xlHidden
    ActiveSheet.PivotTables("ObsoPivot").AddDataField ActiveSheet.PivotTables( _
        "ObsoPivot").PivotFields("NET MARGIN â‚¬"), "Sum of NET MARGIN â‚¬", xlSum
End Sub

Answer 1

'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Prange). _
     CreatePivotTable(TableDestination:=PSheet.Cells(200, 200), TableName:="ObsoPivot")

您正在创建数据透视缓存，然后直接在该缓存上调用CreatePivotTable：这将返回数据透视表，而不是PivotCache ...

所以您只需要第一部分：

Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Prange)

VBA将数据透视表复制到新表

1 个答案: