Hallo,

eine kleine Änderung wurde noch vorgenommen:

In der Arbeitsmappe ist eine unsichtbare leere Tabelle Namens "keine Auswahl" vorhanden. Bei der Auswahl dieses Eintrags wird im Diagramm eine Leere Datenreihe eingetragen.

Mit dieser kleinen Änderung werden nur die sichtbaren Tabellen berücksichtigt:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Set rng = Target.Worksheet.Columns(2)
    If Not Intersect(Target, rng) Is Nothing Then
        Call Diagramm_aktualisieren
    End If
End Sub

Private Sub Diagramm_aktualisieren()
    Dim objChart As Chart
    Dim serItem As Series, serCheck As Series
    Dim rng As Range
    Dim bExists As Boolean
    Set objChart = Me.ChartObjects(1).Chart
        
    ' Alle Datenreihen entfernen
    For Each serItem In objChart.SeriesCollection
        serItem.Delete
    Next
    
    For Each rng In Intersect(Me.UsedRange, Me.Columns(2)).Cells
        If ExistsWorksheet(rng.Value) Then
            bExists = False
            ' Check, ob Datenreihe bereits existiert
            For Each serCheck In objChart.SeriesCollection
                If serCheck.Name = rng.Value Then
                    bExists = True
                    Exit For
                End If
            Next
            If Not bExists Then
                ' Falls Datenreihe nicht vorhanden ist, wird diese neu angelegt
                Set serItem = objChart.SeriesCollection.NewSeries
                Debug.Print rng.Value
                serItem.Name = "=""" & rng.Value & """"
                serItem.XValues = "='" & rng.Value & "'!$B$2:$C$6"
                serItem.Values = "='" & rng.Value & "'!$C$2:$C$6"
            End If
        End If
    Next
End Sub

Private Function ExistsWorksheet(SearchName As String) As Boolean
    Dim wsh As Worksheet
    For Each wsh In ActiveWorkbook.Worksheets
        If wsh.Name = SearchName And wsh.Visible = xlSheetVisible Then
            ExistsWorksheet = True
            Exit For
        End If
    Next
End Function

LG, BigBen