How do I prevent a PivotChart from becoming a regular chart on sheet copy?

Question

Using Excel 2010, I have written some VBA to copy selected sheets from a Master workbook to a Client workbook. The code works just fine to copy the data sheet which has data & PivotTable(s) associated with the data, and the chart sheet with one or more PivotCharts to the new workbook.

The issue is that in the destination workbook, the charts are no longer PivotCharts, they're regular Charts and their Source Data range is blank. The Source Data for the Master PivotChart is filled in, but greyed out so it's not editable.

The issue appears immediately upon copying the worksheet from one workbook to the other (on this line: XLMaster.Sheets(SlideRS.Fields(2).Value).Copy After:=XLClinic.Sheets(XLClinic.Sheets.Count)), though I'll include the code for the call Subs. By the time it gets to those lines, the chart is already broken

The question is three part:

1. Can I prevent the PivotChart being converted into a regular Chart in the copy? i.e. is there a flag/setting for .Copy that I've missed?
2. If not, can I update the chart to be a PivotChart again by something along the lines of cchart.Chart.PivotLayout.PivotTable = mchart.Chart.PivotLayout.PivotTable?
3. Failing either of these, what's the best way to create the PivotChart from scratch in the copied worksheet?

NOTES:

1. These are standard Excel PivotTables, I'm not using PowerPivot. I'm open to that, though, if it will fix the issue. Having just done a little reading on PowerPivot, I don't think it will help me, but, again, I'm open to suggestion.
2. In response to Jens' comment, the raw data and Pivot Tables are on one sheet, and the Pivot Charts are on a second sheet.

Here's the code. It is working great for everything except copying a sheet with a PivotChart intact as a PivotChart.

  While Not SlideRS.EOF                                                   'loop through all the supporting data sheets for this graph sheet
    If SlideRS.Fields(1) <> SlideRS.Fields(2) Then                        'the worksheet depends on something else, copy it first
      If InStr(1, UsedSlides, SlideRS.Fields(2)) = 0 Then                 'if the depended upon slide is not in the list of UsedSlides, then add it
        Form_Master.ProcessStatus.Value = "Processing: " & ClinicName & "  Slide: " & SlideRS!SlideName & "    Worksheet: " & SlideRS.Fields(2).Value
        XLMaster.Sheets(SlideRS.Fields(2).Value).Copy After:=XLClinic.Sheets(XLClinic.Sheets.Count)
        Set NewSheet = XLClinic.Sheets(XLClinic.Sheets.Count)
        UsedSlides = UsedSlides & "," & NewSheet.Name
        UpdateCharts XLMaster.Sheets(SlideRS.Fields(2).Value), NewSheet
        ProcessDataSheet NewSheet, NewXLName
        Set NewSheet = Nothing
      End If
    End If
    SlideRS.MoveNext                                                      'move to the next record of supporting Data sheets
  Wend

Here is the code for UpdateCharts. Its purpose is to copy the colors from the Master to the Client worksheet, since Excel seems to like assigning random colors to the new charts

Private Sub UpdateCharts(ByRef Master As Worksheet, ByRef Clinic As Worksheet)

Dim MChart As Excel.ChartObject
Dim CChart As Excel.ChartObject
Dim Ser As Excel.Series
Dim pnt As Excel.point
Dim i As Integer
Dim Color() As Long
Dim ColorWheel As ChartColors

  Set ColorWheel = New ChartColors
  For Each MChart In Master.ChartObjects
    For Each CChart In Clinic.ChartObjects
      If CChart.Name = MChart.Name Then
        If CChart.Chart.ChartType = xlPie Or _
           CChart.Chart.ChartType = xl3DPie Or _
           CChart.Chart.ChartType = xl3DPieExploded Or _
           CChart.Chart.ChartType = xlPieExploded Or _
           CChart.Chart.ChartType = xlPieOfPie Then
          If InStr(1, CChart.Name, "ColorWheel") Then                  'this pie chart needs to have pre-defined colors assigned
            i = 1
            For Each pnt In CChart.Chart.SeriesCollection(1).Points
              pnt.Format.Fill.ForeColor.RGB = ColorWheel.GetRGB("Pie" & i)
              i = i + 1
            Next
          Else                                                      'just copy the colors from XLMaster
            'collect the colors for each point in the SINGLE series in the MASTER pie chart
            i = 0
            For Each Ser In MChart.Chart.SeriesCollection
              For Each pnt In Ser.Points
                ReDim Preserve Color(i)
                Color(i) = pnt.Format.Fill.ForeColor.RGB
                i = i + 1
              Next 'point
            Next 'series
            'take that collection of colors and apply them to the CLINIC pie chart points
            i = 0
            For Each Ser In CChart.Chart.SeriesCollection
              For Each pnt In Ser.Points
                pnt.Format.Fill.ForeColor.RGB = Color(i)
                i = i + 1
              Next 'point
            Next 'series
          End If
        Else
          'get the series colors from the MASTER
          i = 0
          For Each Ser In MChart.Chart.SeriesCollection
            ReDim Preserve Color(i)
            Color(i) = Ser.Interior.Color
            i = i + 1
          Next 'series
          'assign them to the CLINIC
          i = 0
          For Each Ser In CChart.Chart.SeriesCollection
            Ser.Interior.Color = Color(i)
            i = i + 1
          Next 'series
        End If 'pie chart
      End If 'clinic chart = master chart
    Next 'clinic chart
  Next 'master chart
  Set ColorWheel = Nothing

End Sub

Here is the ProcessDataSheet() code. This will update the data on the sheet based on one or more SQL queries embedded in the sheet.

Private Sub ProcessDataSheet(ByRef NewSheet As Excel.Worksheet, ByRef NewXLName As String)

Const InstCountRow As Integer = 1
Const InstCountCol As Integer = 2
Const InstDataCol As Integer = 2
Const InstCol As Integer = 3
Const ClinicNameParm As String = "{ClinicName}"
Const LikeClinicName As String = "{LikeClinicName}"
Const StartDateParm As String = "{StartDate}"
Const EndDateParm As String = "{EndDate}"
Const LocIDParm As String = "{ClinicLoc}"

Dim Data As New ADODB.Recordset
Dim InstCount As Integer
Dim SQLString As String
Dim Inst As Integer
Dim pt As Excel.PivotTable
Dim Rng As Excel.Range
Dim Formula As String
Dim SChar As Integer
Dim EChar As Integer
Dim Bracket As Integer
Dim TabName As String
Dim RowCol() As String

  'loop through all the instructions on the page and update the appropriate data tables
  InstCount = NewSheet.Cells(InstCountRow, InstCountCol)
  For Inst = 1 To InstCount
    RowCol = Split(NewSheet.Cells(InstCountRow + Inst, InstDataCol), ",")
    SQLString = NewSheet.Cells(InstCountRow + Inst, InstCol)
    SQLString = Replace(SQLString, """", "'")
    If InStr(1, SQLString, LikeClinicName) > 0 Then
      SQLString = Replace(SQLString, LikeClinicName, "'" & ClinicSystoc & "%'")
    Else
      SQLString = Replace(SQLString, ClinicNameParm, "'" & ClinicSystoc & "'")
    End If
    SQLString = Replace(SQLString, LocIDParm, "'" & ClinicLocID & "%'")
    SQLString = Replace(SQLString, StartDateParm, "#" & StartDate & "#")
    SQLString = Replace(SQLString, EndDateParm, "#" & EndDate & "#")
    Data.Open Source:=SQLString, ActiveConnection:=CurrentProject.Connection
    If Not Data.EOF And Not Data.BOF Then
      NewSheet.Cells(CInt(RowCol(0)), CInt(RowCol(1))).CopyFromRecordset Data
    End If
    Data.Close
  Next

  'search for all external sheet refrences and truncate them so it points to *this* worksheet
  Set Rng = NewSheet.Range(NewSheet.Cells.Address).Find(What:=XLMasterFileName, LookIn:=xlFormulas, Lookat:=xlPart, MatchCase:=False)
  While Not Rng Is Nothing
    Formula = Rng.Cells(1, 1).Formula
    If InStr(1, Formula, "'") > 0 Then
      SChar = InStr(1, Formula, "'")
      EChar = InStr(SChar + 1, Formula, "'")
      Bracket = InStr(1, Formula, "]")
      TabName = Mid(Formula, Bracket + 1, EChar - Bracket - 1)
      Rng.Replace What:=Mid(Formula, SChar, EChar - SChar + 1), replacement:=TabName, Lookat:=xlPart
    End If
    Set Rng = NewSheet.Range(NewSheet.Cells.Address).Find(What:=XLMasterFileName, LookIn:=xlFormulas, Lookat:=xlPart, MatchCase:=False)
  Wend
  Set Rng = Nothing

  'fix all the pivot table data sources so they point to *this* spreadsheet
  'TODO: add a filter in here to remove blanks
  'NOTE: do I want to add for all pivots, or only selected ones?
  For Each pt In NewSheet.PivotTables
    Formula = pt.PivotCache.SourceData
    Bracket = InStr(1, Formula, "!")
    Formula = Right(Formula, Len(Formula) - Bracket)
    pt.ChangePivotCache XLClinic.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Formula)
  Next

  SaveNewXL NewXLName         'yes, save the spreadsheet every single time so that the links in the PPT can be updated to point to it.  Sigh...

End Sub

UPDATE

Based on R3uK's suggestion, I've added a call to the beginning of the UpdateCharts Sub, here:

  If Master.ChartObjects.Count > 0 Then
    Set ColorWheel = New ChartColors      'only do this if we need to
  End If
  For Each MChart In Master.ChartObjects
    If Not MChart.Chart.PivotLayout Is Nothing Then

      'Re-copy just the pivot chart from Master to Clinic
      CopyPivotChart PivotItemsList, MChart, CChart, Clinic

    End If

With CopyPivotChart here:

Private Sub CopydPivotChart(ByVal PivotItemsList As PivotTableItems, ByVal MChart As Excel.ChartObject, ByRef CChart As Excel.ChartObject, ByRef Clinic As Worksheet)

Dim TChart As Excel.ChartObject

'Breakpoint 1
  For Each TChart In Clinic.ChartObjects
    If TChart.Name = MChart.Name Then
      TChart.Delete
    End If
  Next

  MChart.Chart.ChartArea.Copy
'Breakpoint 2
  Clinic.PasteSpecial Format:="Microsoft Office Drawing Object", Link:=False, DisplayAsIcon:=False
  Clinic.PasteSpecial Format:=2

End Sub

When I run that code, I now get

Run-time error '1004': Method 'PasteSpecial' of object'_Worksheet' failed

at the line following Breakpoint 2.

Now, if I skip the For Each loop at Breakpoint 1 (manually drag the execution point below the loop), and manually delete the chart from Worksheet Clinic, then the code executes just fine.

Answer 1

1 . In my humble experience of copying Pivot Chart, I didn't copy the Sheet but the Chart :

Sheets("Graph1").ActiveChart.ChartArea.Copy
ActiveSheet.PasteSpecial Format:="Objet Dessin Microsoft Office", _
    Link:=True, DisplayAsIcon:=False

Have you tried to create an empty page and to paste the Chart in it? You probably will have to change the format which is in French, but that should do the trick!

2 . No clue....

3 . For creating an Pivot Table from scratch, I have no magical tricks, but I use this as a template :

Sub Create_DCT(ByVal Source_Table_Name As String, ByVal DCT_Sheet_Name As String, ByVal DCT_Name As String)


    DeleteAndAddSheet DCT_Sheet_Name

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
        SourceData:=Source_Table_Name, _
        Version:=xlPivotTableVersion14). _
        CreatePivotTable _
        TableDestination:=DCT_Sheet_Name & "!R3C1", _
        TableName:=DCT_Name, _
        DefaultVersion:=xlPivotTableVersion14


End Sub

Sub Add_Fields_DCT(ByVal DCT_Sheet_Name As String, ByVal DCT_Name As String)
    Dim Ws As Worksheet
    Set Ws = Worksheets(DCT_Sheet_Name)

    'Organized filters
    With Ws.PivotTables(DCT_Name).PivotFields("Cluster")
        .Orientation = xlPageField
        .Position = 1
    End With
    With Ws.PivotTables(DCT_Name).PivotFields("Region")
        .Orientation = xlPageField
        .Position = 2
    End With
    With Ws.PivotTables(DCT_Name).PivotFields("Account")
        .Orientation = xlPageField
        .Position = 3

    'Organized rows
    With Ws.PivotTables(DCT_Name).PivotFields("Family")
        .Orientation = xlRowField
        .Position = 1
    End With
    With Ws.PivotTables(DCT_Name).PivotFields("Sub_family")
        .Orientation = xlRowField
        .Position = 2
    End With
    With Ws.PivotTables(DCT_Name).PivotFields("Invoice_Country")
        .Orientation = xlRowField
        .Position = 3
    End With
    With Ws.PivotTables(DCT_Name).PivotFields("Product")
        .Orientation = xlRowField
        .Position = 4
    End With

    'Columns : none
'    With Ws.PivotTables(DCT_Name).PivotFields("Family")
'        .Orientation = xlColumnField
'        .Position = 1
'    End With


'Data fields (adding, modifying, formatting and compacting)
    'Data fiels : Adding
    'With Ws.PivotTables(DCT_Name).AddDataField Ws.PivotTables(DCT_Name)
        Ws.PivotTables(DCT_Name).AddDataField Ws.PivotTables(DCT_Name).PivotFields("Quantity"), "Total Qty", xlSum
        Ws.PivotTables(DCT_Name).AddDataField Ws.PivotTables(DCT_Name).PivotFields("Quantity"), "Avg Qty", xlAverage
        Ws.PivotTables(DCT_Name).AddDataField Ws.PivotTables(DCT_Name).PivotFields("Quantity"), "Qty of Orders", xlCount
        Ws.PivotTables(DCT_Name).AddDataField Ws.PivotTables(DCT_Name).PivotFields("TotalAmountEUR"), "TO (€)", xlSum
        Ws.PivotTables(DCT_Name).AddDataField Ws.PivotTables(DCT_Name).PivotFields("UPL"), "Avg UPL", xlAverage
        Ws.PivotTables(DCT_Name).AddDataField Ws.PivotTables(DCT_Name).PivotFields("Discount"), "Avg Discount", xlAverage
        Ws.PivotTables(DCT_Name).AddDataField Ws.PivotTables(DCT_Name).PivotFields("Discount"), "Min Discount", xlMin
        Ws.PivotTables(DCT_Name).AddDataField Ws.PivotTables(DCT_Name).PivotFields("Discount"), "Max Discount", xlMax
        Ws.PivotTables(DCT_Name).AddDataField Ws.PivotTables(DCT_Name).PivotFields("PVU"), "Min PVU", xlMin
        Ws.PivotTables(DCT_Name).AddDataField Ws.PivotTables(DCT_Name).PivotFields("PVU"), "Max PVU", xlMax
        Ws.PivotTables(DCT_Name).AddDataField Ws.PivotTables(DCT_Name).PivotFields("(PVU-PRI)/PVU"), "Gross Margin", xlAverage
        Ws.PivotTables(DCT_Name).AddDataField Ws.PivotTables(DCT_Name).PivotFields("(PVU-TC)/PVU"), "Net Margin", xlAverage
        Ws.PivotTables(DCT_Name).AddDataField Ws.PivotTables(DCT_Name).PivotFields("PVU-PRI"), "Gross Profit (€)", xlSum
        Ws.PivotTables(DCT_Name).AddDataField Ws.PivotTables(DCT_Name).PivotFields("PVU-TC"), "Net Profit (€)", xlSum
    'End With

    'Data fiels : Modifying
'    With Ws.PivotTables(DCT_Name).PivotFields("Somme de Quantity")
'        .Caption = "Moyenne de Quantity"
'        .Function = xlAverage
'    End With



    'Data formatting
    With ActiveSheet.PivotTables(DCT_Name)
        .PivotFields("Total Qty").NumberFormat = "# ##0"
        .PivotFields("Avg Qty").NumberFormat = "# ##0,#"
        .PivotFields("Qty of Orders").NumberFormat = "# ##0"
        .PivotFields("TO (€)").NumberFormat = "# ##0 €"
        .PivotFields("Avg UPL").NumberFormat = "# ##0 €"
        .PivotFields("Avg Discount").NumberFormat = "0,0%"
        .PivotFields("Min Discount").NumberFormat = "0,0%"
        .PivotFields("Max Discount").NumberFormat = "0,0%"
        .PivotFields("Min PVU").NumberFormat = "# ##0 €"
        .PivotFields("Max PVU").NumberFormat = "# ##0 €"
        .PivotFields("Gross Margin").NumberFormat = "0,0%"
        .PivotFields("Net Margin").NumberFormat = "0,0%"
        .PivotFields("Gross Profit (€)").NumberFormat = "# ##0 €"
        .PivotFields("Net Profit (€)").NumberFormat = "# ##0 €"
    End With


'Compact row fields to minimum
For Each PivIt In ActiveSheet.PivotTables(DCT_Name).PivotFields("Sub_family").PivotItems
    PivIt.DrillTo "Invoice_Country"
Next PivIt

For Each PivIt In ActiveSheet.PivotTables(DCT_Name).PivotFields("Family").PivotItems
    PivIt.DrillTo "Sub_family"
Next PivIt

For Each PivIt In ActiveSheet.PivotTables(DCT_Name).PivotFields("Family").PivotItems
    PivIt.DrillTo "Family"
Next PivIt

End Sub

And my custom fucntion DeleteAndAddSheet :

Public Function DeleteAndAddSheet(ByVal SheetName As String) As Worksheet

For Each aShe In Sheets
    If aShe.Name <> SheetName Then
    Else
        Application.DisplayAlerts = False
        aShe.Delete
        Application.DisplayAlerts = True
        Exit For
    End If
Next aShe

Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = SheetName

Set DeleteAndAddSheet = ThisWorkbook.Worksheets(Worksheets.Count)

End Function

Hope it will help you!