Sub Grafik()
Dim rng As Range
ActiveCell.Select
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-16]C:R[-14]C)"
ActiveCell.Select
Selection.Copy
ActiveCell.Offset(3, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(3, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(3, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(3, 0).Select
ActiveSheet.Paste
ActiveSheet.Shapes.AddChart2(240, xlXYScatter).Select
Set rng = ActiveCell
With ActiveChart
.SeriesCollection.NewSeries
.FullSeriesCollection(1).Name = "=""Einzelwerte"""
.FullSeriesCollection(1).XValues = "='Tabelle 1'!$B$29:$B$43"
.FullSeriesCollection(1).Values = Range(rng.Offset(-29, 0), rng.Offset(-14, 0))
.SeriesCollection.NewSeries
.FullSeriesCollection(2).Name = "=""Mittelwert"""
.FullSeriesCollection(2).XValues = "='Tabelle 1'!$C$31:$C$43"
.FullSeriesCollection(2).Values = Range(rng, rng.Offset(-12, 0))
.PlotArea.Select
.FullSeriesCollection(2).Trendlines.Add Type:=xlLinear, Forward _
:=0, Backward:=0, DisplayEquation:=0, DisplayRSquared:=0, Name:= _
"Linear (Mittelwert)"
.FullSeriesCollection(2).Trendlines(1).Select
Selection.DisplayEquation = True
Selection.DisplayRSquared = True
Application.CommandBars("Format Object").Visible = False
.FullSeriesCollection(2).Trendlines(1).DataLabel.Select
Selection.Left = 237.787
Selection.Top = 34.767
End With
End Sub