(Solved) – how to copy charts from one sheet to another or set the destination of the chart?


So how my code works is that it will plot chart based on the X values in column A and the y columns are the alternation columns (Eg:mean graph x values=entirecolumn1, y values = entirecolumn 2,4,6..etc , sigma graph x values = entire column1, y values =entirecolumn 3,5,7..).

All my graphs are plotted on the same worksheets(“data”) but i find it to be very messy. I tried to copy and paste all my charts into different worksheets namely sigmagraphs and meangraphs but it only copies and paste for the meangraphs portion only(not sure where it went wrong). So what can i do to make sure all my graphs in data copy and paste accordingly to different worksheets or is it possible to just set the destination of the charts from the start to worksheet sigmagraphs and meangraphs?

Anyways i did not include the code for sigmagraphs because the code will be too long but the code is almost the same as meangraphs’s code with Set rngY = rngDB.Columns(3) and different axes.

enter image description here

Sub plotgraphs()

Call meangraph
Call sigmagraph

End Sub

Private Sub meangraph()
    Dim i As Long, c As Long
    Dim shp As Shape
    Dim Cht As chart, co As Shape
    Dim rngDB As Range, rngX As Range, rngY As Range
    Dim Srs As Series
    Dim ws As Worksheet

    Set ws = Sheets("Data")

    Set rngDB = ws.Range("A1").CurrentRegion

    Set rngX = rngDB.Columns(1)
    Set rngY = rngDB.Columns(2)

    Do While Application.CountA(rngY) > 0

        Set co = ws.Shapes.AddChart
        Set Cht = co.chart

        With Cht
            .ChartType = xlXYScatter
            'remove any data which might have been
            '  picked up when adding the chart
            Do While .SeriesCollection.Count > 0
            'add the data
            With .SeriesCollection.NewSeries()
                .XValues = rngX.Value
                .Values = rngY.Value
            End With
            With Cht.Axes(xlValue)
                .MinimumScale = 5
                .MaximumScale = 20
                .TickLabels.NumberFormat = "0.00E 00"
            End With
            Cht.Axes(xlCategory, xlPrimary).HasTitle = True
            Cht.Axes(xlValue, xlPrimary).HasTitle = True
        End With
          Set rngY = rngY.Offset(0, 2) 'next y values


         Dim OutSht As Worksheet

    Dim PlaceInRange As Range

    Set OutSht = ActiveWorkbook.Sheets("meangraphs") '<~~ Output sheet
    Set PlaceInRange = OutSht.Range("B2:J21")        '<~~ Output location

    'Loop charts
    For Each chart In Sheets("Data").ChartObjects
        'Copy/paste charts
        OutSht.Paste PlaceInRange
        'Code below changes the range itself to something 20 rows below
        Set PlaceInRange = PlaceInRange.Offset(20, 0)
    Next chart

End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *