• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Add New Sheet

T

Tripp

Member
Hello,

I am trying to write a macro that copies a Pivot Table and pastes it in a new sheet with the name "Table". I would also like to check if a sheet with the name "Table" already exists and overwrite it if it does. I have put my code below but I'm getting stuck on the line 11.

1 Sub PivotCopy()
2 Dim ws As Worksheet
3 Set ws = Worksheets.Add(after:=Sheets(Sheets.Count))
4 ws.Name = "Table"
5 Application.ScreenUpdating = False
6
7 Sheets("PivotTable").Select
8 ActiveSheet.PivotTables("PivotTable3").PivotSelect "", xlDataAndLabel, True
9 Selection.Copy
10 'Add code to check for tab with same name and overwite if there is
11 ws.Range("A1").PasteSpecial
12
13 Application.CutCopyMode = False
14 Application.ScreenUpdating = True
15 End Sub

Regards,

Tripp
 
Managed to sort it incase anyone else has a similar situation.


Code: 
Sub PivotCopy()

Dim ws As Worksheet
Dim SheetName As String

SheetName = "Table"

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Checks for Sheet named "Table" and deletes it if there is one.

    If SheetCheck(SheetName) = True Then
        Worksheets(SheetName).Delete
        Else
    End If

Set ws = Worksheets.Add(after:=Sheets(Sheets.Count))
ws.Name = SheetName

'Find the sheet with Pivot Table on and copies the whole thing

Sheets("PivotTable").Select
ActiveSheet.PivotTables("PivotTable3").PivotSelect "", xlDataAndLabel, True
Selection.Copy

'Pastes the Pivot Table as table in new Sheet

ws.Range("A1").PasteSpecial


Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

Function SheetCheck(SheetName As String) As Boolean
    SheetCheck = False
    For Each Sheet In Worksheets
        If SheetName = Sheet.Name Then
            SheetCheck = True
            Exit Function
        End If
    Next Sheet
End Function
 
This might work:
Code: 
Sub PivotCopy()
Dim ws As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Table").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set ws = Worksheets.Add(after:=Sheets(Sheets.Count))
ws.Name = "Table"
Sheets("PivotTable").PivotTables("PivotTable3").TableRange2.Copy ws.Range("A1")
End Sub
 
Tripp said:
p45cal,

With your code I get an error on the Sheets("table").Delete when there is no Table sheet.
Click to expand...
That would come as a BIG surprise:
1. I tested the code multiple ways.
2. There's a On Error Resume Next line just before that line.
Check if you've really tried my code rather than some version if it.
 
So after using your code I've realized that I dont want to delete the Table sheet only clear it as I'm using it to populate charts and when the sheets is deleted and remade I get lots of #REF on the charts.
 
Ive changed it to the following but this always assumes there is a Table sheet. I'm unsure how to add a check and create if its not there.
Code: 
Sub PivotCopyChan()

Dim ws As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Table").UsedRange.ClearContents
On Error GoTo 0
Application.DisplayAlerts = True
Set ws = Sheets("Table")

Sheets("PivotTable").PivotTables("PivotTable3").TableRange2.Copy
ws.Range("A1").PasteSpecial xlPasteValues

End Sub
 
Are these charts based on the pivot table?
If so it might be a lot easier just to change the pivot table's pivotcache? Especially if the pivot tables are based on the same sets of headers.
 
They are but I am converting the pivot table to data on another sheet as I am making lots of scatter charts out of it.
 
You had it before (nearly):
Code: 
Sub PivotCopyChan()
Dim ws As Worksheet
If Not SheetCheck("Table") Then Worksheets.Add(after:=Sheets(Sheets.Count)).Name = "Table"
Set ws = Sheets("Table")
ws.UsedRange.ClearContents
Sheets("PivotTable").PivotTables("PivotTable3").TableRange2.Copy
ws.Range("A1").PasteSpecial xlPasteValues
End Sub
Of course your SheetCheck function should exist.
 
You must log in or register to reply here.
Back
Top