So trennst Du die Diagramme gleich:
Option Explicit
Sub neu()
Dim BereichB As String
Dim BereichA As String
Dim BereichF As String
Dim CRT As Long
Dim tVerschub As Long
With ActiveSheet
.Range("A1").Select 'erstes Diagramm
BereichB = "$B2:$B$" & Application.WorksheetFunction.CountA(.Range("B:B"))
BereichB = BereichB & ",$D$2:$D$" & Application.WorksheetFunction.CountA(.Range("D:D"))
Charts.Add
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=Sheets("Tabelle1").Range(BereichB), PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Tabelle1"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "TestB"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "KreuzdiagrammB"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Auf- und AbwärtsB"
End With
'zweites Diagramm
BereichA = "$A2:$A$" & Application.WorksheetFunction.CountA(.Range("A:A"))
BereichA = BereichA & ",$B$2:$B$" & Application.WorksheetFunction.CountA(.Range("B:B"))
BereichA = BereichA & ",$C$2:$C$" & Application.WorksheetFunction.CountA(.Range("C:C"))
BereichA = BereichA & ",$D$2:$D$" & Application.WorksheetFunction.CountA(.Range("D:D"))
Charts.Add
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=Sheets("Tabelle1").Range(BereichA), PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Tabelle1"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "TestA"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "KreuzdiagrammA"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Auf- und AbwärtsA"
End With
'drittes Diagramm
BereichF = "$F2:$F$" & Application.WorksheetFunction.CountA(.Range("F:F"))
BereichF = BereichB & ",$G$2:$G$" & Application.WorksheetFunction.CountA(.Range("G:G"))
BereichF = BereichB & ",$H$2:$H$" & Application.WorksheetFunction.CountA(.Range("H:H"))
Charts.Add
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=Sheets("Tabelle1").Range(BereichF), PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Tabelle1"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "TestF"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "KreuzdiagrammF"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Auf- und AbwärtsF"
End With
'Diagramme trennen
tVerschub = 0
For CRT = 1 To .ChartObjects.Count
.ChartObjects(CRT).Activate
ActiveChart.ChartArea.Select
.Shapes(CRT).IncrementLeft 300#
.Shapes(CRT).IncrementTop -170# + (tVerschub) * 400#
tVerschub = tVerschub + 1
Next CRT
ActiveWindow.Visible = False
Windows(ThisWorkbook.Name).Activate
.Range("A1").Select
End With
End Sub
Severus |