Нужен код для копирования сводной таблицы / сводной диаграммы на новый лист

Question

Итак, у меня есть лист данных. На этом листе данных есть кнопка, которая создает новый лист данных и сводную таблицу с использованием данных на листе данных. Эта кнопка также создает другую кнопку на новом листе сводной таблицы с именем «Создать сводную диаграмму» (которая создает сводную диаграмму с использованием данных сводной таблицы и помещает ее на новый лист). Это прекрасно работает для создания одной сводной таблицы и одной сводной диаграммы, но мне нужно иметь возможность создавать несколько сводных таблиц / диаграмм с одинаковыми данными, но с разными фильтрами и тому подобное.

Private Sub PivotTableButton1_Click()


'Macro By ExcelChamps

'Declare Variables
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long

'Insert a New Blank Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("DataTable")

'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)

'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="ParetoPivotTable")

'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="ParetoPivotTable")

'Insert Row Fields
With ActiveSheet.PivotTables("ParetoPivotTable").PivotFields("Pareto")
.Orientation = xlRowField
.Position = 1
End With

'Insert Column Fields


'Insert Data Field
With ActiveSheet.PivotTables("ParetoPivotTable").PivotFields("Pareto")
.Orientation = xlDataField
.Position = 1
.Function = xlCount
.Name = "Pareto"
End With

'Insert Filter
With ActiveSheet.PivotTables("ParetoPivotTable").PivotFields("model_code")
        .Orientation = xlPageField
        .Position = 1
    End With



'Format Pivot Table

ActiveSheet.PivotTables("ParetoPivotTable").PivotFields("Pareto").AutoSort _
        xlDescending, "Count of Pareto"


    Dim objObject As Object
    Dim strCode As String
        Set objObject = ActiveSheet.Buttons.Add(611.25, 63, 138, 39)
        objObject.Name = "PivotChartButton"
        objObject.Caption = "Create PivotChart"
        objObject.OnAction = "PivotChartButton_Click"


End Sub

Sub PivotChartButton_Click()

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotChart").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotChart"
Application.DisplayAlerts = True


    Dim wksPivot As Worksheet
    Dim wksDest As Worksheet
    Dim oChart As Chart
    Dim oPT As PivotTable
    Dim rDest As Range

    Set wksPivot = Worksheets("PivotTable") 'change the sheet name accordingly
    Set wksDest = Worksheets("PivotChart") 'change the sheet name accordingly

    Set oPT = wksPivot.PivotTables("ParetoPivotTable")

    Set rDest = wksDest.Range("E2:X35")

    With rDest
        Set oChart = wksDest.ChartObjects.Add(Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Chart
    End With

    With oChart
        .ChartType = xlColumnClustered
        .SetSourceData oPT.TableRange1
    End With

    wksDest.Activate

End Sub

Простое создание копии листа сводной таблицы работает, но кнопка на скопированном листе перезаписывает кнопку на исходном листе ...