Hi AB33,
Okay, I've tried implementing your suggested changes, but they are throwing up other errors (which I'll detail in another post) and I'm still struggling to understand what the problem is. What I've done is to post the original code below, which all worked really well. This was designed to copy selected worksheets (defined in the array) to a new workbook and then copy and paste values and formats, so there were no actual pivot tables, formulas or links back to the original workbook in the new workbook. These worksheets contained a mixture of pivot tables and formula driven tables and charts.
Even though this technique worked well there was a problem where it was impossible to get the charts SERIES source to change to the newly created worksheet. As a result what I'm trying to do now (in the second piece of code) is almost the opposite. Rather than copy the specified worksheets to a new workbook, I'm simply deleting the worksheets I don't want in the original workbook but then attempting to copy/paste values and format for the sheets remaining (which are the ones originally copied to the new workbook above), the ones containing the pivot tables, formula driven tables and charts. This way the original problem with the charts SERIES data not changing to the new workbook should vanish.
I'm sort of assuming part of the problem is that in the original code there were two workbooks, one to copy from the other to copy to, but in my amended version, the code is trying to copy and paste within the same workbook and can't, though I'm not entirely sure. I have tried duplicating the worksheets I want to keep within the same workkbook with a view to trying to copy and paste between the two but again the copy/paste routine still failed.
Original Working Code
Sub MyBigReport()
Dim wb As Workbook
Dim ws As Worksheet
Dim varMySheet As Variant
Dim pt As PivotTable, arr, rng As Range, i As Long, FName
Dim oChart As ChartObject
Dim mySrs As Series
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Unhide hidden worksheets so they can be copied to a new workbook as part of the array
For Each varMySheet In Array("Seven", "Eight")
Sheets(varMySheet).Visible = xlSheetVisible
Next varMySheet
'Create a new blank workbook and copy selected worksheets to it
Set wb = Workbooks.Add
Set ws = wb.Worksheets(1): arr = Array("One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight")
'Copy Pivot Table Range and Paste Values and Formats to equivalent worksheets in newly created workbook
ThisWorkbook.Worksheets(arr).Copy Before:=ws
For i = 1 To UBound(arr) + 1
For Each pt In Worksheets(i).PivotTables
ws.Cells.Clear: Set rng = pt.TableRange2: rng.Copy
ws.Range("A1").PasteSpecial (xlPasteValues)
ws.Range("A1").PasteSpecial (xlPasteFormats)
rng.Clear: ws.Range("A1").CurrentRegion.Copy rng
Next pt
Next i
'Copy all other data, e.g. formula driven data and paste values to equivalent worksheets in newly created workbook
For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Copy
ws.[A1].PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Cells(1, 1).Select
ws.Activate
Next ws
Cells(1, 1).Select
i = UBound(arr) + 2
While wb.Worksheets.Count >= i
wb.Worksheets(i).Delete: Wend
Worksheets("Executive Summary Report").Activate
'This code was designed to change the SERIES data source for the charts but owing to the nature of the way the charts were created this failed to work
For Each ws In ActiveWorkbook.Worksheets
For Each oChart In ws.ChartObjects
For Each mySrs In oChart.Chart.SeriesCollection
mySrs.Formula = WorksheetFunction.Substitute(mySrs.Formula, "MyOriginal Workbook.xlsm", "MyBigReport.xlsx")
Next
Next
Next
'Hide worksheets that we don't want to be visible in the final workbook
For Each varMySheet In Array("Seven", "Eight")
Sheets(varMySheet).Visible = xlVeryHidden
Next varMySheet
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Show Save As dialogue window with filename pre-populated, asking the user to save using this name or to provide their own filename. Save the file using a .xlsx format
FName = Application.GetSaveAsFilename(InitialFileName:="C:\My Folder\MyBigReport (" & Format(DateAdd("m", -1, Now), "mmmm") & ").xlsx", fileFilter:="Excel workbook (*.xlsx), *.xlsx")
On Error Resume Next: If FName <> False Then wb.SaveAs FName
'Error handler if user saves the file but the filename already exists
If Err.Number <> 0 Then
Application.Dialogs(xlDialogSaveAs).Show
Err.Clear
End If
End Sub
My attempt at adapting the code above so it deletes the unwanted worksheets from the current workbook and then Copy/Paste Values and Formats for the remaining worksheets and then saves the file with a new name.
Revised Code
Sub MyNewBigReport()
Dim wb As Workbook
Dim ws As Worksheet
Dim varMySheet As Variant
Dim pt As PivotTable, arr, rng As Range, i As Long, FName
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Make all xlVeryhidden Worksheets visible so unwanted worksheets can be removed from the Workbook
For Each varMySheet In Array("Red", "Green", "Blue", "Yellow", "Orange", "Black", "White", "Pink", "Seven", "Eight")
Sheets(varMySheet).Visible = xlSheetVisible
Next varMySheet
'Select which Worksheets to keep in the New Workbook, deleting all other Worksheets
For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Name
Case "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight"
'Do Nothing
Case Else
ws.Delete
End Select
Next ws
'Copy and Paste values and formats for all Pivot Tables
Set ws = ActiveWorkbook.Worksheets(1): arr = Array("One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight")
For i = 1 To UBound(arr) + 1
For Each pt In Worksheets(i).PivotTables
ws.Cells.Clear: Set rng = pt.TableRange2: rng.Copy
ws.Range("A1").PasteSpecial (xlPasteValues)
ws.Range("A1").PasteSpecial (xlPasteFormats)
rng.Clear: ws.Range("A1").CurrentRegion.Copy rng
rng.Parent.ListObjects.Add xlSrcRange, rng, , xlYes
Next pt
Next i
'Copy and Paste Values for all non Pivot Table worksheets
For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Copy
ws.[A1].PasteSpecial Paste:=xlValues
ws.Range("A1").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Cells(1, 1).Select
ws.Activate
End With
Next ws
Cells(1, 1).Select
i = UBound(arr) + 2
While ActiveWorkbook.Worksheets.Count >= i
ActiveWorkbook.Worksheets(i).Delete: Wend
'Define which Worksheet is shown by default when the file is opened
Worksheets("One").Activate
'Saves the Workbook with a new name
ActiveWorkbook.SaveAs Filename:="C:\MyFolder\MyNewBigReport Report (" & Format(DateAdd("m", -1, Now), "mmmm") & ").xlsx", FileFormat:=51
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks