Option Explicit

Private Const mc_MsgTitle As String = _
      "VB-fun-Demo - Diagramm-Daten ermitteln"

Public Sub GetChartValues()
  Dim objWksDest  As Worksheet

  Dim objChart    As Chart
  Dim objSeries   As Series

  Dim nRowsCnt    As Long
  Dim nCol        As Integer

  If TypeName(Selection) = "ChartArea" Then
    Set objChart = ActiveChart
    If objChart.SeriesCollection.Count > 0 Then
      nRowsCnt = UBound(objChart.SeriesCollection(1).Values)

      Set objWksDest = Worksheets.Add(After:=ActiveSheet)
      With objWksDest
        .Range(.Cells(2, 1), .Cells(nRowsCnt + 1, 1)) = _
            Application.Transpose( _
            objChart.SeriesCollection(1).XValues)
      End With

      nCol = 2
      On Error Resume Next
      For Each objSeries In objChart.SeriesCollection
        With objWksDest
          .Cells(1, nCol) = objSeries.Name
          .Range(.Cells(2, nCol), .Cells(nRowsCnt + 1, nCol)) = _
                Application.Transpose(objSeries.Values)
        End With
        nCol = nCol + 1
      Next
      On Error GoTo 0
      Set objWksDest = Nothing

    Else
      MsgBox "Es sind keine Datenreihen vorhanden !", _
             vbOKOnly + vbInformation, mc_MsgTitle
    End If
    Set objChart = Nothing

  Else
    MsgBox "Bitte wählen Sie ein Diagramm aus !", _
           vbOKOnly + vbInformation, mc_MsgTitle
  End If
End Sub