|
Hallo Leute,
ich habe ein ziemliches Problem, aber ich finde dazu leider anderswo keine Hilfe. Ich habe 8 Sheets mit jeweils den gleichen Daten, aus denen jeweils eine Grafik erstellt wird. Dies geschieht mit folgendem Programmteil:
Sub grafik1()
Dim myarray2(1 To 8) As String
myarray2(1) = "Kerosen-DK-1061"
myarray2(2) = "Kerosen-DW-1061"
myarray2(3) = "Mitteloil-DK-1071"
myarray2(4) = "Mitteloil-DW-1121BC"
myarray2(5) = "S-Mitteloil-DK-1081"
myarray2(6) = "S-Mitteloil-DW-1081"
myarray2(7) = "LR-DW-1091A-B"
myarray2(8) = "MCR-DW-1076"
'On Error Resume Next
For i = 1 To 8
Sheets(myarray2(i)).Activate
'ActiveSheet.Columns("B").Delete Shift:=xlToLeft 'ActiveCell.Offset(0, -3).Columns("!$A:$D").EntireColumn.Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Sheets(myarray2(i)).Range("$A:$E")
'ActiveChart.Axes(x1value).MajorGridlines.Select
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).AxisGroup = 2 ActiveChart.SeriesCollection(1).name = "=""Remaining Corrosion Allowance"""
ActiveChart.SeriesCollection(2).name = "=""Day Corrosion Rate"""
ActiveChart.SeriesCollection(3).name = "=""Design Corrosion Rate"""
'ActiveChart.SeriesCollection(4).name = "=""C1"""
Next
Das klappt auch alles super. Nun will ich diese Grafiken aber alle ins Sheet1 rüber kopieren. Das funktioniert laut Makrorecorder so:
Sheets("Kerosen-DK-1061").Select
ActiveChart.ChartArea.Select
ActiveChart.Parent.Cut
Sheets("Sheet1").Select
ActiveSheet.Paste
Sheets("Kerosen-DW-1061").Select
ActiveChart.ChartArea.Select
ActiveChart.Parent.Cut
Sheets("Sheet1").Select
ActiveCell.Offset(0, 8).Range("A1").Select
ActiveSheet.Paste
Sheets("Mitteloil-DK-1071").Select
ActiveChart.ChartArea.Select
ActiveChart.Parent.Cut
Sheets("Sheet1").Select
ActiveWindow.SmallScroll Down:=9
ActiveCell.Offset(16, -8).Range("A1").Select
ActiveSheet.Paste
Sheets("Mitteloil-DW-1121BC").Select
ActiveChart.ChartArea.Select
ActiveChart.Parent.Cut
Sheets("Sheet1").Select
ActiveCell.Offset(0, 8).Range("A1").Select
ActiveSheet.Paste
Sheets("S-Mitteloil-DK-1081").Select
ActiveChart.ChartArea.Select
ActiveChart.Parent.Cut
ActiveChart.ChartArea.Select
ActiveChart.Parent.Cut
Sheets("Sheet1").Select
ActiveWindow.SmallScroll Down:=12
ActiveCell.Offset(16, -8).Range("A1").Select
ActiveSheet.Paste
Sheets("S-Mitteloil-DW-1081").Select
ActiveChart.ChartArea.Select
ActiveChart.Parent.Cut
ActiveChart.ChartArea.Select
ActiveChart.Parent.Cut
Sheets("Sheet1").Select
ActiveCell.Offset(0, 8).Range("A1").Select
ActiveSheet.Paste
Sheets("LR-DW-1091A-B").Select
ActiveChart.ChartArea.Select
ActiveChart.Parent.Cut
ActiveChart.ChartArea.Select
ActiveChart.Parent.Cut
Sheets("Sheet1").Select
ActiveWindow.SmallScroll Down:=21
ActiveCell.Offset(16, -8).Range("A1").Select
ActiveSheet.Paste
Sheets("MCR-DW-1076").Select
ActiveChart.ChartArea.Select
ActiveChart.Parent.Cut
ActiveChart.ChartArea.Select
ActiveChart.Parent.Cut
Sheets("Sheet1").Select
ActiveCell.Offset(0, 8).Range("A1").Select
ActiveSheet.Paste
End Sub
Jedoch sagt er mir jetzt die Pastemethode des Objekts konnte nicht ausgeführt werden?? und hört einfach nach der ersen Grafik auf das rüber zu kopieren.
Ich bin gerade am verzweifeln! Könnt ihr mir sagen wie ich das repariere??
Vielen Dank schonmal ;)
|