AW: Tabellenblatt in neue Arbeitsmappe kopieren
26.04.2013 17:34:27
Beverly
Hi Nik,
manchmal macht Excel Dinge, die es an anderer Stelle nicht macht - das muss man nicht unbedingt verstehen. Das ist auch hier der Fall - weshalb der Fehler plötzlich auftritt ist nicht nachvollziehbar.
Du hast den Code vom Prinzip her schon richtig verändert und an deine Bedingugnen angepasst. Was nicht korrekt war ist, dass du die Spalten A, B und C prüfst, ob dort ein Fehler steht - korrekt müssen Spalte C und D geprüft werden, das ist aber nicht die Ursache des auftretenden Codefehlers. Den Spaltenbereich, aus dem die Daten entnommen werden, musst du auch anpassen - jetzt ist Spalte P die letzte und nicht mehr N, weshalbe anstelle der 14 die 16 beim Zellbezug als Spaltennummer stehen muss. Aber auch das löst nicht den Fehler aus. Der Fehler wird urplötzlich bei der Zuweisung des Zellbereichs für den Namen ausgelöst, obwohl du den Teil korrekt angepasst hast. Möglicherweis knn Excel nicht damit umgehen, wenn nicht Spalte A mit inbegriffen ist sondern nur Spalten weiter rechts - aber das ist nur eine Vermutung, ich kenne die tatsächliche Ursache nicht.
Es gibt aber die Möglichkeit, den Zellbereich auch auf andere Weise zuzuweisen, und zwar als Formel für den Bezug zum Zellbereich - genau so wie es dann im Diagramm zu sehen ist, z.B. "=Sheet1!B17:C17".
Ich habe mal den Code entsprechend geändert (auch mit den o.g. Anpassungen):
Sub DiasKopieren()
Dim lngZeile As Long ' Schleifenvariable
Dim dblOben As Double ' Variable für die Position der Diagrammoberkante
Dim dblHoehe As Double ' Variable für die Diagrammhöhe
ActiveSheet.Copy
With ActiveSheet.UsedRange
.Copy
.Cells(1).PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
Application.ScreenUpdating = False
For lngZeile = 17 To IIf(IsEmpty(Cells(Rows.Count, 3)), _
Cells(Rows.Count, 3).End(xlUp).Row, Rows.Count) Step 4
' Position Oberkante des letzten Diagramms
dblOben = ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Top
' Höhe des letzten Diagramsm
dblHoehe = ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Height
' 1. Diagramm kopieren
ActiveSheet.ChartObjects(1).Copy
' Kopie ins Tabellenblatt einfügen
ActiveSheet.Paste
' bezogen auf das zuletzt erstellte Diagramm
With ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Chart
' Datenbereich zuweisen auf leere Zelle C1, damit keine
' Datenreihe mehr vorhanden ist
.SetSourceData Source:=ActiveSheet.Range("C1")
'4.2 wenn in C und D der laufenden Zelle kein Fehler steht, dann neue Datenreihe
If Not IsError(ActiveSheet.Cells(lngZeile, 3)) And _
Not IsError(ActiveSheet.Cells(lngZeile, 4)) Then
' neue Datenreihe hinzufügen
With .SeriesCollection.NewSeries
' 4.2.1 Beschriftung Rubrikenachse (X-Werte für E12:P12 eintragen)
.XValues = ActiveSheet.Range("E12:P12")
' 4.2.2 Y-Werte für E bis P laufende Zeile eintragen)
.Values = ActiveSheet.Range(ActiveSheet.Cells(lngZeile, 5), _
ActiveSheet.Cells(lngZeile, 16))
' 4.2.3 Name für den Bereich laufende Zeile in Spalte C und D)
.Name = "=" & ActiveSheet.Name & "!" & ActiveSheet.Range( _
ActiveSheet.Cells(lngZeile, 3), _
ActiveSheet.Cells(lngZeile, 4)).Address
End With
End If
If Not IsError(ActiveSheet.Cells(lngZeile + 1, 3)) And _
Not IsError(ActiveSheet.Cells(lngZeile + 1, 4)) Then
With .SeriesCollection.NewSeries
.XValues = ActiveSheet.Range("E12:P12")
.Values = ActiveSheet.Range(ActiveSheet.Cells(lngZeile + 1, 5), _
ActiveSheet.Cells(lngZeile + 1, 16))
.Name = "=" & ActiveSheet.Name & "!" & ActiveSheet.Range( _
ActiveSheet.Cells(lngZeile + 1, 3), _
ActiveSheet.Cells(lngZeile + 1, 4)).Address
End With
End If
If Not IsError(ActiveSheet.Cells(lngZeile + 2, 3)) And _
Not IsError(ActiveSheet.Cells(lngZeile + 2, 4)) Then
With .SeriesCollection.NewSeries
.XValues = ActiveSheet.Range("E12:P12")
.Values = ActiveSheet.Range(ActiveSheet.Cells(lngZeile + 2, 5), _
ActiveSheet.Cells(lngZeile + 2, 16))
.Name = "=" & ActiveSheet.Name & "!" & ActiveSheet.Range( _
ActiveSheet.Cells(lngZeile + 2, 3), _
ActiveSheet.Cells(lngZeile + 2, 4)).Address
End With
End If
If Not IsError(ActiveSheet.Cells(lngZeile + 3, 3)) And _
Not IsError(ActiveSheet.Cells(lngZeile + 3, 4)) Then
With .SeriesCollection.NewSeries
.XValues = ActiveSheet.Range("E12:P12")
.Values = ActiveSheet.Range(ActiveSheet.Cells(lngZeile + 3, 5), _
ActiveSheet.Cells(lngZeile + 3, 16))
.Name = "=" & ActiveSheet.Name & "!" & ActiveSheet.Range( _
ActiveSheet.Cells(lngZeile + 3, 3), _
ActiveSheet.Cells(lngZeile + 3, 4)).Address
End With
End If
' Position obere Kante des eingefügten Diagrammobjektes
.Parent.Top = dblOben + dblHoehe
' Position linke Kante des eingefügten Diagrammobjektes auf linke Kante Spalte C
.Parent.Left = ActiveSheet.Columns(3).Left
End With
DoEvents
Next lngZeile
Application.ScreenUpdating = True
End Sub
Ich habe auch noch die Position der linken Diagrammkante angepasst, die ja nun nicht mehr Spalte A sondern Spalte C ist.