Hi, using excel 2010 and trying to create macro package for fast save. Have an external file with multiple pivot tables that I'm using and copying certain pages out of the old workbook to create a new workbook and breaking links to the old. I specify the new source as table 1 in the new workbook, but after saving the new workbook it's coming up with "The PivotTable report was saved without the underlying data". I would like for the new workbook to be saved with the new specified data active and not have refresh the Pivots on each tab. Below is a portion of the code i'm using.
My thought is the astrlinks should be reactivated before saving but I'm not sure how.
Dim astrLinks As Variant
' Define variable as an Excel link type.
astrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
' Break the first link in the active workbook.
For i = 1 To UBound(astrLinks)
ActiveWorkbook.BreakLink _
Name:=astrLinks(i), _
Type:=xlLinkTypeExcelLinks
Next i
Application.ScreenUpdating = True
Dim PT As PivotTable
For Each PT In ActiveWorkbook.Worksheets("Monthly").PivotTables
PT.ChangePivotCache ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:="Table1")
Next PT
For Each PT In ActiveWorkbook.Worksheets("MTD").PivotTables
PT.ChangePivotCache ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:="Table1")
Next PT
For Each PT In ActiveWorkbook.Worksheets("YTD").PivotTables
PT.ChangePivotCache ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:="Table1")
Next PT
For Each PT In ActiveWorkbook.Worksheets("YTD by Project").PivotTables
PT.ChangePivotCache ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:="OwningOrg!Table1")
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
Next PT
For Each PT In ActiveWorkbook.Worksheets("Budget").PivotTables
PT.ChangePivotCache ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:="OwningOrg!Table1")
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
Next PT
Application.ScreenUpdating = True
For Each PivotTable In ActiveSheet.PivotTables
PivotTable.RefreshTable
Next
Sheets("Monthly").Select
Range("A1").Select
fName = "\" & Range("a2") & " - " & Range("A1").Value & ".xls"
sname = ThisWorkbook.Path
Wb.SaveAs sname & fName
Wb.Close False
Application.ScreenUpdating = True
'
End Sub
Bookmarks