Guten Abend zusammen,

ich arbeite grad an einem Script welches folgenes machen soll:

Ich habe 3 Worksheets mit gleich formatierten Daten mit jeweils 5 Spalten. Innerhalb des Worksheets sind die Spalten gleichlang. Aber über verschiedene WS hinweg kann die Länge variieren.

Im letzten Worksheet "Diagramm" Sollen nun Graphen in EINEM Diagramm erstellt werden. Die DAten dazu kommen aus den anderen Worksheets.

Also:

Worksheet1 | Worksheet2 | Diagramm

Mein Script funktioniert auch bisher sehr gut. Das einzige was nicht funktionieren will ist dass alle Graphen in einem Diagramm landen. Ich bekomme immer pro Worksheet ein Diagramm.

Der Fehler müsste meiner Meinung nach irgendwo bei "With .SeriesCollection(1) " liegen welches in in die Schleife einbauen muss. Wenn ich aber statt der 1 eine Variable vergebe bricht der Code ab.

Hat jemand einen Tipp?

Danke,

viele Grüße

Sub DiagrammeAlleWorksheets()
'
' Makro10 Makro
'

'
Dim r_cnt As Integer 'row count
Dim c_cnt As Integer 'column count
Dim Datenzeile1 As Integer
Dim XSpalte As Integer
Dim ws As Worksheet
Dim wsName As String
Dim wsAnzahl As String
Dim NoWS As Integer         'Laufvariable Anzahl Worksheets in Schleife
Dim i As Integer
Dim lngReihe As Long


   'Diagramme einfügen
       
    
    'r_cnt = Cells(Rows.Count, 1).End(xlUp).Row 'Zeilenende suchen
    Datenzeile1 = 2 'Diagrammstartzeile
    XSpalte = 1
    c_cnt = 2 'YSpalte
    
    'Anzahl Worksheets im Workbook
    wsAnzahl = ActiveWorkbook.Worksheets.Count
    
       
    'Ab hier werden die Diagramme erstellt
    i = 1
    For NoWS = 1 To wsAnzahl - 1
    Sheets(NoWS).Select
    r_cnt = Cells(Rows.Count, 1).End(xlUp).Row 'Zeilenende suchen
           With Sheets("Diagramm").Shapes.AddChart.Chart
            .ChartType = xlXYScatterSmoothNoMarkers
            
            If .SeriesCollection.Count > 0 Then
                For lngReihe = .SeriesCollection.Count To 1 Step -1
                .SeriesCollection(lngReihe).Delete
                Next lngReihe
            End If
            .SeriesCollection.NewSeries
            With .SeriesCollection(1) 
            .Name = Sheets(NoWS).Name   
            .XValues = "=" & Sheets(NoWS).Name & "!" & Range(Cells(Datenzeile1, XSpalte), Cells(r_cnt, XSpalte)).Address
            .Values = "=" & Sheets(NoWS).Name & "!" & Range(Cells(Datenzeile1, c_cnt), Cells(r_cnt, c_cnt)).Address
            End With

        End With
                i = i + 1
                '.HasLegend = False
        
    Next
    MsgBox i
 
End Sub