Copy and Paste From Pivot Tables Into New Workbook

icekiwikiwi

New Member
Joined
Oct 20, 2021
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
Hi everyone

I have a workbook with the same pivot table filtered around 25 different ways, each on a separate tab. I need to copy and paste it to a new document without the pivot tables, but still retaining the formatting.

I have butchered together the following code (which works) but I feel like there are probably a number of redundancies here. The code itself takes a few minutes to run so its quite resource intensive.

Any suggestions to streamline my code are appreciated! Thank you.

VBA Code:
Sub Duplicate_Workbook

Dim Sh As Worksheet

Application.ScreenUpdating = False
Application.Cursor = xlWait


ActiveWorkbook.Sheets.Copy

     For Each Sh In ActiveWorkbook.Worksheets
        If Sh.Visible = True Then
            Sh.Activate
            Sh.Cells.Copy
            Sh.Range("A1").PasteSpecial Paste:=xlPasteValues
            Sh.Activate
            Sh.Cells.Copy
            Sh.Range("A1").PasteSpecial Paste:=xlPasteFormats
            Sh.Range("A1").Select
        End If
    Next Sh
    
Application.CutCopyMode = False

Application.ScreenUpdating = True
Application.Cursor = xlDefault

End Sub
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Hi

I think in the main you could try and switch off auto calc while the macro runs.

Untested, but try:
VBA Code:
Sub Duplicate_Workbook()
    Dim Sh As Worksheet
    
    With Application
        .Calculation = xlManual '< turn off automatic calculation
        .ScreenUpdating = False
        .Cursor = xlWait
    End With
    
    ActiveWorkbook.Sheets.Copy

     For Each Sh In ActiveWorkbook.Worksheets
        With Sh
            If Sh.Visible Then '< don't need = True
                'Sh.Activate '< don't need to activate it
                .UsedRange.Copy '< only copy the used range, not everything
                .Range("A1").PasteSpecial Paste:=xlPasteValues
                Sh.Activate '< don't need to activate
                'Sh.Cells.Copy '< don't need to copy, it is already on the clipboard
                .Range("A1").PasteSpecial Paste:=xlPasteFormats
                .Range("A1").Select
            End If
        End With
    Next Sh
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
        .Calculation = xlAutomatic 'turn calc back on
        .Cursor = xlDefault
    End With
End Sub
 
Upvote 0
@Jon von der Heyden

Thanks for the prompt response, however I receive the following error:

Run time error 1004: We can't make this change for the selected cells because it will affect a PivotTable. Use the field list to change the report. If you are trying to insert or delete cells, move the PivotTable and try again.

Any idea how I could fix this? Thanks!
 
Upvote 0
Ok so I suppose that is why .Cells is better than .UsedRange.

For startrs use .Cells again (replace where I have used .UsedRange) and see if the calculation toggle makes much difference in terms of speed. I have an alternative in mind if it's still not good enough, although it is a bit more involved.
 
Upvote 0
@Jon von der Heyden

Thanks for the prompt response, however I receive the following error:

Run time error 1004: We can't make this change for the selected cells because it will affect a PivotTable. Use the field list to change the report. If you are trying to insert or delete cells, move the PivotTable and try again.

Any idea how I could fix this? Thanks!
Try commenting out these 2 lines:
VBA Code:
                'Sh.Activate '< don't need to activate

                '.Range("A1").Select
 
Upvote 0
I made the following changes to the code based on your replies, however the formatting of the pivot table doesn't copy across - its just pasted as values into a new document. There is a table also in the worksheet and the formatting comes across fine, so I think the issue must be specific to pivot tables?

VBA Code:
Sub Duplicate_Workbook()
    Dim Sh As Worksheet
    
    With Application
        .Calculation = xlManual '< turn off automatic calculation
        .ScreenUpdating = False
        .Cursor = xlWait
    End With
    
    ActiveWorkbook.Sheets.Copy

     For Each Sh In ActiveWorkbook.Worksheets
        With Sh
            If Sh.Visible Then '< don't need = True
                'Sh.Activate '< don't need to activate it
                .Cells.Copy '< only copy the used range, not everything
                .Range("A1").PasteSpecial Paste:=xlPasteValues
                'Sh.Activate '< don't need to activate
                'Sh.Cells.Copy '< don't need to copy, it is already on the clipboard
                .Range("A1").PasteSpecial Paste:=xlPasteFormats
                '.Range("A1").Select
            End If
        End With
    Next Sh
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
        .Calculation = xlAutomatic 'turn calc back on
        .Cursor = xlDefault
    End With
End Sub
 
Upvote 0
Scratch that - although it doesn't copy across the default pivot table shading and colouring, once you edit it away from that it comes across fine. Thanks for the help!
 
Upvote 0
Sorry one final question - after generating the new workbook all of the cells in each of the tabs are still highlighted blue from being copied, I think I got round this before by selecting cell A1 in each tab before moving onto the next sheet, but when I plug in

VBA Code:
.Range("A1").Select I get the same error.

Any way I can fix this?
 
Upvote 0
I expected this. You need to copy pivots in 2 steps to get the shading to copy, which gets messy when you want multiple whole sheets.
it doesn't copy across the default pivot table shading and colouring
But I don't understand what you mean by this :-
Can you explain and perhaps a picture
once you edit it away from that it comes across fine.
 
Upvote 0
I expected this. You need to copy pivots in 2 steps to get the shading to copy, which gets messy when you want multiple whole sheets.

But I don't understand what you mean by this :-
Can you explain and perhaps a picture
Sorry what I meant was when you leave the default pivot table formatting with the light blue shading, it doesn't copy across.

If however I highlight the titles and apply my own shading, fonts etc, this DOES come across. I expect what I am doing is applying formatting on top of the pivot table.

Now I just need to work out how to make sure each tab is unselected after being copied and pasted. It's currently left highlighted in the new document.
 
Upvote 0

Forum statistics

Threads
1,213,532
Messages
6,114,177
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top