Diagramme aus Tabelle

Hi,

ich habe eine Tabelle, die in Row 1 ab Spalte F, 26 Überschriften enthält.
in row 17 sind Werte, die ab Spalte F bis AE (26) enthalten sind.

Markiere ich F1-AE1 und danach mit STRG F17-AE17 und gehe auf Einfügen, Diagramme etc. bekomme ich beim ersten Anlauf ein perfektes Balkendiagramm, das auf der X-Achse alle 26 Überschriften aus F1-AE1 enthält und die Werte F17-AE17 als je einen Balken.

Versuche ich das zu automatisieren, klappt es nicht, denn die X Achse enthält nur eine 1 statt den Überschriften aus F1-AE1. Hier mein Code. Ich bedanke mich für alle Beiträge, die weiterhelfen.

ich gehe in das Blatt "Datenbasis" und suche eine Position aus Spalte E aus. Von dort aus wird der Code ausgelöst.Ich erkläre zuerst 2 ranges. Wertebereich und Überschriftenleiste und vereine diese zu diagrammbereich.

Sub Diagrammerstellen()

Sheets("Datenbasis").Activate

Dim i As Integer
Dim eingebettetesdiagramm As Shape
Dim rng As Range
Dim diagrammbereich As Range, wertebereich As Range

Dim bezeichnung As Range


Set bezeichnung = Selection

If Selection.Rows.Count > 1 Or Selection.Columns.Count > 1 Then
    MsgBox ("Bitte wählen Sie nur eine Position in Spalte E aus"), vbOKOnly + vbCritical, "Warnung"
    Exit Sub
End If


'    ActiveChart.SetSourceData Source:=Range( _
'        "Datenbasis!$F$17:$AE$17,Datenbasis!$F$1:$AE$1")

Dim zeile As Integer
zeile = ActiveCell.Row '.Count


'Set wertebereich = Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 26))
Set wertebereich = Range("Datenbasis!F" & zeile & ":AE" & zeile)

    wertebereich.Select
    
Dim überschriftenleiste As Range
Set überschriftenleiste = Range("Datenbasis!$F$1:$AE$1")

    überschriftenleiste.Select

Set diagrammbereich = Union(überschriftenleiste, wertebereich)

    diagrammbereich.Select
    
    

Dim jahrrng As Range
Dim werterng As Range

'Bereinigen
    Dim zelle As Range
    For Each zelle In diagrammbereich
        If zelle.Value = "leer" Or zelle.Value = "fehlende Angabe" Or zelle.Value = "0,001" Then
            zelle.Value = ""
        End If
    Next



Sheets("Visualisierung").Activate

Set rng = Range("a2:e32")

'Cells(1, 1).Value = bezeichnung

Set eingebettetesdiagramm = Sheets("Visualisierung").Shapes.AddChart2(201, xlColumnClustered, Left:=rng.Left, Width:=rng.Width, Top:=rng.Top, Height:=rng.Height)

    eingebettetesdiagramm.Chart.SetSourceData Source:=diagrammbereich
    
    eingebettetesdiagramm.Chart.ClearToMatchStyle

    
    
    
    eingebettetesdiagramm.Chart.HasTitle = True
        eingebettetesdiagramm.Chart.ChartTitle.Text = bezeichnung

    'eingebettetesdiagramm.Chart.ChartTitle.format.TextFrame2.TextRange.Font.Size = 11
    'eingebettetesdiagramm.Chart.SetElement (msoElementDataLabelOutSideEnd)
    'eingebettetesdiagramm.Chart.SetElement (msoElementDataLabelNone)
    'eingebettetesdiagramm.Chart.SetElement (msoElementDataTableWithLegendKeys)
    'eingebettetesdiagramm.Chart.SetElement (msoElementLegendNone)
    eingebettetesdiagramm.Chart.Axes(xlCategory).TickLabelPosition = xlLow
    eingebettetesdiagramm.Chart.SetElement (msoElementDataLabelOutSideEnd)

                    
Dim seriescol As Integer, startseriescol As Integer
seriescol = eingebettetesdiagramm.Chart.SeriesCollection.Count
For startseriescol = 1 To seriescol
    eingebettetesdiagramm.Chart.FullSeriesCollection(startseriescol).DataLabels.Position = xlLabelPositionCenter
eingebettetesdiagramm.Chart.FullSeriesCollection(startseriescol).DataLabels.Orientation = xlUpward
eingebettetesdiagramm.Chart.FullSeriesCollection(startseriescol).DataLabels.Font.Size = 12
Next


                    
'Alles nach unten schieben

    Rows("1:33").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(34, 1).Select
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell