I originally tried to copy selected worksheets containing a mix of pivot tables and formula driven cells from my main workbook to a new workbook and then copy/paste values so that all the information was 'unlinked' from the orignal workbook and the pivot tables were now just tables and no longer pivot tables.
This all worked well thanks to help from this website, however that approach ran into some problems, so I'm now adopting a different approach. Instead of copying the specified worksheets to a new workbook, I'm simply deleting the unwanted worksheets from the main workbook and resaving the workbook using a different name.
As a result I'm having a few issues with the code that originally copied the worksheets to the new workbook. Instead of copying and pasting values to the new workbook, I need the code to run on the remaining worksheets in the current workbook but I can't get this to work correctly (despite many hours of trying) and I'd be extremely grateful if anyone can help be adjust the code to achieve this.
It is the code in red where I'm having the problems. This is (I think) still trying to copy the specified worksheets in the array to a new workbook, but the code needs to run in the current workbook. I hope this makes sense.
Many thanks
Sub DeleteSheetsandPasteValues()
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 they can be removed from the New Workbook
For Each varMySheet In Array("Red", "Green", "Blue", "Yellow", "Orange", "Black", "White", "Pink", "Brown", "Purple")
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
'Paste values and formats for all Pivot Tables
Set wb = Workbooks.Add
Set ws = wb.Worksheets(1): arr = Array("One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight")
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
'Paste Values for all non Pivot Table worksheets
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
'Define which Worksheet is shown
Worksheets("Executive Summary Report").Activate
'Saves the Workbook after deleting unwanted Worksheets and Pasting Values and Formats for the remaining Worksheets
ActiveWorkbook.SaveAs Filename:="C:\Reports\My Report (" & Format(DateAdd("m", -1, Now), "mmmm") & ").xlsx", FileFormat:=51
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Bookmarks