Save charts of a workbook into another new workbook

[minghong]

Hello! All. I want to save some charts in an Excel file(workbook1) into a new Excel file(workbook2) and save the new Excel file as a new name and in a fixed location of some folder. Could anybody give me some suggestions? Thanks in advance!

[MWE]

Hello! All. I want to save some charts in an Excel file(workbook1) into a new Excel file(workbook2) and save the new Excel file as a new name and in a fixed location of some folder. Could anybody give me some suggestions? Thanks in advance!

do you wish to do this "manually" or do you wish to develop some VBA code to do it "automatically" (perhaps with some manual intervention)?

[minghong]

I wish to develop some VBA code to do it automatically. Since I want to do it within a loop, I prefer there's no manual intervention. Thanks!

[minghong]

Could anybody give me any suggestions? Thanks!

[geekgirlau]

Could you attach a sample workbook?

[minghong]

I can give an example. I have a Excel file named " Results1" and there're about three charts in it. Say chart1, chart2 and chart3. What I want to do is copy and save those charts into a new Excel file and name it as" Charts output1" in a particular folder. The reason of why I name these two files with a number 1 is because I need to do a loop to repeat the " copy and save" process to deal with around 100 files. Thanks!

[geekgirlau]

The first step is to record a macro to copy 1 chart. Select Tools | Macro | Record New macro. Give your macro a name, then step through the process of copying a chart, pasting into a new workbook and saving the result. Then we can have a look at setting up the loop.

[Justinlabenne]

Are these chart-sheets or chart objects on a worksheet?

[BlueCactus]

The first step is to record a macro to copy 1 chart. Select Tools | Macro | Record New macro. Give your macro a name, then step through the process of copying a chart, pasting into a new workbook and saving the result. Then we can have a look at setting up the loop.

Probably going to have to copy the source data too, then break the link between the duplicate chart and the original sheet. Can get a little tedious.

[minghong]

Thanks, Geekgirlar! I will try that.
They are all chart sheets. Justin!
Nice suggestion! BlueCactus.

[Justinlabenne]

This is a start: it delinks the charts when they get copied to the new workbook, but I am quite sure you will need a different naming sequence when saving the new workbook because it is set up to just name the new workbook the same every time, which will overwrite the previous workbook, so let me know if this works for you and what mods are required.

Option Explicit

Sub CopyChartsToNewBookAndDelinkThemToo()
    Dim Cht As Chart
    Dim oCht As ChartObject
    Dim oSeries As Series
    Dim wks As Worksheet
    Dim CurSht As String
CurSht = ActiveSheet.Name
With Application.ScreenUpdating = False
For Each Cht In ThisWorkbook.Charts
        Cht.Select False
    Next Cht
ActiveWindow.SelectedSheets.Copy
For Each Cht In ActiveWorkbook.Charts
    For Each oSeries In Cht.SeriesCollection
        With oSeries
            .Name = .Name
            .Values = .Values
            .XValues = .XValues
        End With
    Next
    Next
For Each wks In ActiveWorkbook.Worksheets
        If wks.Type <> xlChart Then
            Application.DisplayAlerts = False
            wks.Delete
        End If
    Next wks
    Application.DisplayAlerts = False
With ActiveWorkbook
        .SaveAs ThisWorkbook.Path & "\Charts1.xls"
        .Close
    End With
Sheets(CurSht).Select
    With Application.ScreenUpdating = True
End Sub

[minghong]

This is a start: it delinks the charts when they get copied to the new workbook, but I am quite sure you will need a different naming sequence when saving the new workbook because it is set up to just name the new workbook the same every time, which will overwrite the previous workbook, so let me know if this works for you and what mods are required.

Option Explicit
 
Sub CopyChartsToNewBookAndDelinkThemToo()
Dim Cht As Chart
Dim oCht As ChartObject
Dim oSeries As Series
Dim wks As Worksheet
Dim CurSht As String
CurSht = ActiveSheet.Name
With Application.ScreenUpdating = False
For Each Cht In ThisWorkbook.Charts
Cht.Select False
Next Cht
ActiveWindow.SelectedSheets.Copy
For Each Cht In ActiveWorkbook.Charts
For Each oSeries In Cht.SeriesCollection
With oSeries
.Name = .Name
.Values = .Values
.XValues = .XValues
End With
Next
Next
For Each wks In ActiveWorkbook.Worksheets
If wks.Type <> xlChart Then
Application.DisplayAlerts = False
wks.Delete
End If
Next wks
Application.DisplayAlerts = False
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\Charts1.xls"
.Close
End With
Sheets(CurSht).Select
With Application.ScreenUpdating = True
End Sub

Thank you so much! Justin. When I try to run this sample program, it stopped at the With statement ( I marked it as red in the code) and I got a error massage " Compile error: With object must be user-defined type, Object or Variant" . I never use With this way before, so I don't know what's wrong here. Thank you again!

[Justinlabenne]

Jeez... I was having a bad day.

Try like this with no "Withs"

Option Explicit

Sub CopyChartsToNewBookAndDelinkThemToo()
    Dim Cht As Chart
    Dim oCht As ChartObject
    Dim oSeries As Series
    Dim wks As Worksheet
    Dim CurSht As String
CurSht = ActiveSheet.Name
Application.ScreenUpdating = False
For Each Cht In ThisWorkbook.Charts
        Cht.Select False
    Next Cht
ActiveWindow.SelectedSheets.Copy
For Each Cht In ActiveWorkbook.Charts
    For Each oSeries In Cht.SeriesCollection
        With oSeries
            .Name = .Name
            .Values = .Values
            .XValues = .XValues
        End With
    Next
    Next
For Each wks In ActiveWorkbook.Worksheets
        If wks.Type <> xlChart Then
            Application.DisplayAlerts = False
            wks.Delete
        End If
    Next wks
    Application.DisplayAlerts = False
With ActiveWorkbook
        .SaveAs ThisWorkbook.Path & "\Charts1.xls"
        .Close
    End With
Sheets(CurSht).Select
    Application.ScreenUpdating = True
End Sub

[JonPeltier]

I can copy those charts in one line:

ActiveWorkbook.Charts.Copy

This makes copies of all of the chart sheets, and puts them into a new workbook, without any worksheets. There is no delinking of the charts from the source data, of course, and no save-as code. You can use Justin's.

[minghong]

Hi! Jon, thank you for your reply! Actually, I do need to delink the charts from the source data and save them into a new workbook with a new name, cause when I run the program using different data series sets, the worksheets and charts in the original workbook will be updated with time. When I run Justin's example, I can not find where the new workbook saved, i.e. I need to give a fixed path of folder to save those new workbooks or a massagebox for users to input a path they want to save them. Thank you all!

[JonPeltier]

Based on Justin's procedure, here's how you could do this. I'll add a little documentation too, which is out of character, but I'll make an exception just this once.

Option Explicit 

Sub CopyChartsToNewBookAndDelinkThemToo2() 
    Dim Cht As Chart 
    Dim oSeries As Series 
    Dim wks As Worksheet 
Application.ScreenUpdating = False 
' This copies the charts all to a new workbook
    ' The new workbook becomes the active workbook
    ActiveWorkbook.Charts.Copy
' This unlinks each chart from the data
    ' Warning: if there are many points (like 40-50) 
    ' or data contains many significant digits,
    ' this part can produce errors.
    For Each Cht In ActiveWorkbook.Charts 
        For Each oSeries In Cht.SeriesCollection 
            With oSeries 
                .Name = .Name 
                .Values = .Values 
                .XValues = .XValues 
            End With 
        Next 
    Next 
' This is where the new workbook is saved and closed
    ' Insert your own mechanism for defining a path and filename
    With ActiveWorkbook 
        .SaveAs ThisWorkbook.Path & "\Charts1.xls" 
        .Close 
    End With 
Application.ScreenUpdating = True 
End Sub

[minghong]

Thank you so much, Jon! Your explanation is crystal. I'll try that and if I get something, I'll let you know. Thank you!!!