I’m attempting to copy three sheets (two sheets are pivot tables, one is the source data for those pivots) from one workbook to a new workbook.
The code below copies the desired sheets to the new workbook and saves it (modified original):
Sub ExportFile() Dim NewName As String Dim nm As Name Dim ws As Worksheet With Application .ScreenUpdating = False On Error GoTo ErrCatcher ' Array of sheets to copy Sheets(Array("sourcedata", "pivot", "pivot2")).Copy On Error GoTo 0 For Each ws In ActiveWorkbook.Worksheets ws.Cells.Copy ' Paste sheets ws.[A1].PasteSpecial ' Remove external links, hyperlinks and hard-code formulas ws.Cells.Hyperlinks.Delete Application.CutCopyMode = False ' Select A1 on sheet Cells(1, 1).Select ws.Activate Next ws Cells(1, 1).Select ' Save it in the same directory as original and close ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\export.xls" ActiveWorkbook.Close SaveChanges:=False .ScreenUpdating = True End With Exit Sub ErrCatcher: MsgBox "Specified sheets do not exist within this workbook" End Sub
However, when I open the new workbook, the data source in the pivot tables still point to the original workbook. My colleague explained that this is because the sheets are being copied one by one, rather in a group and suggested to copy the sheets as a range. How would I go about copying the sheets as a range or would it be easier way to change the data source to the new copied sheets?
You can simplify the creating a new workbook part by copying the entire worksheets, rather than the cells.
As far as pointing the new pivots to the new source, all you need to do is remove the external reference from the PivotSource. It’s in the format
[oldworkbook]sourcedata!A1:Z100 so you just need to truncate the part within the brackets. (This isn’t a universal solution, but in this case we’re copying the data source tab and the pivot tabs simultaneously, so we know the new workbook will have a data tab with the same name, same size, same range, etc as the original workbook)
Sub CopyPivotsAndData() Dim wb As Excel.Workbook, wbNew As Excel.Workbook Dim ws As Excel.Worksheet Dim pt As Excel.PivotTable Dim s As String Dim r As Integer Set wb = ThisWorkbook wb.Worksheets(Array("sourcedata", "pivot", "pivot2")).Copy Set wbNew = ActiveWorkbook Set ws = wbNew.Worksheets("pivot") Set pt = ws.PivotTables(1) s = pt.SourceData r = InStr(s, "]") pt.SourceData = Mid(s, r + 1) 'repeat for pivot2, or loop if you have many worksheets wbNew.SaveAs "newworkbookname.xlsx" 'close or clean up as necessary End Sub
You’re probably going to want to “move”(the worksheet equivalent of cut) the worksheets instead of just copying them. Copying anything in excel doesn’t change any references to the new location of the copied data(it still uses the original data). But cutting data from one place to another will change any references to the new location of that data. So I would do something like this:
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select Sheets("Sheet3").Activate Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Move Before:=Workbooks("Book2").Sheets(2)
This was recorded – obviously you would want to use the .Move command appropriately for your specific situation.
Or if you are doing this for cells you would want to use:
It looks like you are closing the original workbook without saving at
ActiveWorkbook.Close SaveChanges:=False so i don’t think this is an issue – but just as an FYI: cutting won’t affect your original copy unless you save it aftwerwards.
I felt that the easiest option was to just change the data source on the pivots. Not sure if this is the cleanest syntax or if there is a shortcut, but it works for me.
' Change pivot table data source ActiveWorkbook.Worksheets("pivot").PivotTables("PivotTable1").ChangePivotCache ActiveWorkbook. _ PivotCaches.Create(SourceType:=xlDatabase, SourceData:="stagePivotData", _ Version:=xlPivotTableVersion10)