excel - Trendline Equation Copy Paste in Cell

Question

I am trying to use macros to copy paste the equation of a trendline from a graph to a cell. I am getting an error at Selection.copy.

Sub Equations()
    'Equations Macro
    'Keyboard Shortcut: Ctrl+e

    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.FullSeriesCollection(1).Trendlines(1).DataLabel.Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=3
    Range("C56").Select
    ActiveSheet.Paste
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.FullSeriesCollection(2).Trendlines(1).DataLabel.Select
    Selection.Copy
    Range("D56").Select
    ActiveSheet.Paste
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.FullSeriesCollection(3).Trendlines(1).DataLabel.Select
    Selection.Copy
    Range("E56").Select
    ActiveSheet.Paste
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.FullSeriesCollection(4).Trendlines(1).DataLabel.Select
    Selection.Copy
    Range("F56").Select
    ActiveSheet.Paste
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.FullSeriesCollection(5).Trendlines(1).DataLabel.Select
    Selection.Copy
    Range("G56").Select
    ActiveSheet.Paste
End Sub

Answer 1

Here's a way to cycle through the SeriesCollection of a chart and extract the equation from the trend line associated with each Series in it. If needed, you can change each instance of SeriesCollection to FullSeriesCollection.

---

The code

• checks if the series in question has a at least one Trendline - note there could be multiple. This code only deals with the first but could be easily modified to loop through multiple trend lines.
• checks if the TrendLine is displaying its equation.
• "Copies" the text of the equation to a specified Range. Here the Offset is moving 1 column to the right for each successive trend line. On the first iteration, B56 is offset 1 column so that your equation appears in C56.

---

Sub Equations()
    Dim chrtObj As ChartObject
    Dim i As Long
    
    Set chrtObj = Sheets("Sheet1").ChartObjects("Chart 1") ' Change to your sheet name here
   
    With chrtObj.Chart
        For i = 1 To .SeriesCollection.Count
            If .SeriesCollection(i).Trendlines.Count > 0 Then
                With .SeriesCollection(i).Trendlines(1)
                    If .DisplayEquation Then
                        Sheets("Sheet1").Range("B56").Offset(0, i).Value = .DataLabel.Text ' Change sheet name here as well
                    End If
                End With
            End If
        Next i
    End With

End Sub