Transfer Pivot Cache from a Pivot on one file to a Pivot on another?
I need to safely transfer the cache of a Pivot Table on an Excel File, into a pivot on a different file. How can I do this?
This is the code I'm using now (Notice this method works even if the Source pivot Data Source has been eliminated):
Public Sub TransferPivotCache(Source As PivotTable, Target As PivotTable)
Dim TempSheet As Worksheet
Set TempSheet = ThisWorkbook.Sheets.Add
Source.TableRange2.Copy Destination:=TempSheet.Range("A1")
Target.CacheIndex = TempSheet.PivotTables(1).CacheIndex
TempSheet.Delete
End Sub
However when the pivot I'm importing is too big I get the error "Not enough memory" when modifying the cache index property. And afterwards, even the file closes and if I try to reopen it, it's corrupted. Is there a better way to transfer a Pivot Cache between pivot tables?
If your goal it to update another pivot table targeting the same data, then another way would be to create a new PivotCache pointing to the same source. This way, the targeted workbook will build the same PivotCache without the need to copy the DataTable , which is probably the cause of your memory issue.
Public Sub TransferPivotCache(source As PivotTable, target As PivotTable)
Dim pivCache As PivotCache, sh As Worksheet, rgData As Range, refData
' convert the `SourceData` from `xlR1C1` to `xlA1` '
source.Parent.Activate
refData = Application.ConvertFormula(source.SourceData, xlR1C1, xlA1, xlAbsolute)
If IsError(refData) Then refData = source.SourceData
If Not IsError(source.Parent.Evaluate(refData)) Then
' create a new pivot cache from the data source if it exists '
Set rgData = source.Parent.Evaluate(refData)
If Not rgData.ListObject Is Nothing Then Set rgData = rgData.ListObject.Range
Set pivCache = target.Parent.Parent.PivotCaches.Create( _
XlPivotTableSourceType.xlDatabase, _
rgData.Address(external:=True))
pivCache.EnableRefresh = False
target.ChangePivotCache pivCache
Else
' copy the pivot cache since the data source no longer exists '
Set sh = source.Parent.Parent.Sheets.Add
source.PivotCache.CreatePivotTable sh.Cells(1, 1)
sh.Move after:=target.Parent ' moves the temp sheet to targeted workbook '
' replace the pivot cache '
target.PivotCache.EnableRefresh = True
target.CacheIndex = target.Parent.Next.PivotTables(1).CacheIndex
target.PivotCache.EnableRefresh = False
'remove the temp sheet '
target.Parent.Next.Delete
End If
End Sub
I was not able to reproduce the resource issue with my Excel Professional 2010... But have you tried this simpler possibility?:
Public Sub TransferPivotCache(SourcePivot As PivotTable, TargetPivot As PivotTable)
TargetPivot.CacheIndex = SourcePivot.CacheIndex
End Sub
It looks like it does the same (at least within the same workbook), and it avoids creating a whole new sheet.
链接地址: http://www.djcxy.com/p/91516.html上一篇: 通用程序的nim类型定义是什么？