Fehler beim "worksheet.copy", aber wieso?
13.02.2007 12:58:02
Boris
ich bekomme einen "Laufzeitfehler 1004, copy method of worksheet class failed" in der unten markierten Zeile, das komische ist: der Fehler tritt nicht immer auf, und auch nicht immer an der selben Stelle.
Erklärung des Tools: Das Makro wird von Sheet(1) aus aufgerufen und löscht zunächst alle Sheets, die nach Sheet(2) (="Template") kommen. Dann werden xl-Files aus einem Verzeichnis nacheinander geöffnet, die Daten in "Template" kopiert, Charts aktualisiert und dieses Template ans Ende kopiert (wo "MANCHMAL" der Fehler auftritt):
Sub DatenKonsolidieren()
Application.ScreenUpdating = False
Call LöscheOutputSheets
Call KopiereOutputSheets
ThisWorkbook.Sheets(1).Activate
Application.ScreenUpdating = True
End Sub
Private Sub LöscheOutputSheets()
Dim i As Integer
Application.DisplayAlerts = False
For i = 3 To ThisWorkbook.Sheets.Count
ThisWorkbook.Sheets(3).Delete
Next i
Application.DisplayAlerts = True
End Sub
Private Sub KopiereOutputSheets()
Dim Mappe As String
Dim i As Integer, j As Integer, vtemp As Integer
Dim SheetName As String
Dim arrFiles() As Integer
Dim VLink As Variant, k As Integer
Dim QuellOrdner As String
Dim objBild As Object
Dim WS As Worksheet
Set WS = ThisWorkbook.Worksheets("Template")
QuellOrdner = ThisWorkbook.Path & "\..\Reports\"
'Erstellen der Integer-Arrays mit den ID-Nummern (alphanumerisch sortiert):
Mappe = Dir(QuellOrdner & "*.xls")
i = 0
Do While Mappe <> ""
i = i + 1
ReDim Preserve arrFiles(1 To i)
arrFiles(i) = Left(Mappe, InStr(Mappe, ".") - 1)
Mappe = Dir
Loop
'Numerische Sortierung der Integer-Arrays:
For j = UBound(arrFiles) - 1 To LBound(arrFiles) Step -1
'Alle links davon liegenden Zeichen auf richtige Sortierung der jeweiligen Nachfolger überprüfen:
For i = LBound(arrFiles) To j
'Ist das aktuelle Element seinem Nachfolger gegenüber korrekt sortiert?
If arrFiles(i) > arrFiles(i + 1) Then
'Element und seinen Nachfolger vertauschen.
vtemp = arrFiles(i)
arrFiles(i) = arrFiles(i + 1)
arrFiles(i + 1) = vtemp
End If
Next i
Next j
'Öffnen der einzelnen Dateien und kopieren der Datensätze:
For i = 1 To UBound(arrFiles)
Workbooks.Open QuellOrdner & arrFiles(i) & ".xls", UpdateLinks:=0
ThisWorkbook.Sheets("Template").Range("C3").Value = arrFiles(i)
'Kopieren der Datenbereiche
Workbooks(arrFiles(i) & ".xls").Sheets(1).Range("A1:S50").Copy WS.Range("AF72")
Workbooks(arrFiles(i) & ".xls").Sheets(2).Range("A1:E54").Copy WS.Range("AF13")
'Aktualisierung der Charts
WS.ChartObjects("Chart 1").Chart.SeriesCollection(1).Values = "='Template'!" & WS.Range("AC7").Value
WS.ChartObjects("Chart 2").Chart.SeriesCollection(1).Values = "='Template'!" & WS.Range("AC8").Value
WS.ChartObjects("Chart 3").Chart.SeriesCollection(1).Values = "='Template'!" & WS.Range("AC4").Value
WS.ChartObjects("Chart 4").Chart.SeriesCollection(1).Values = "='Template'!" & WS.Range("AC5").Value
WS.ChartObjects("Chart 5").Chart.SeriesCollection(1).Values = "='Template'!" & WS.Range("AC6").Value
WS.ChartObjects("Chart 6").Chart.SeriesCollection(1).Values = "='Template'!" & WS.Range("AC9").Value
IN FOLGENDER ZEILE TRITT DER FEHLER AUF:
ThisWorkbook.Sheets("Template").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = arrFiles(i)
' VLink = ActiveWorkbook.LinkSources(xlExcelLinks)
' If Not IsEmpty(VLink) Then
' For k = 1 To UBound(VLink)
' ActiveWorkbook.BreakLink VLink(k), Type:=xlLinkTypeExcelLinks
' Next k
' End If
Workbooks(arrFiles(i) & ".xls").Close savechanges:=False
Next i
End Sub
Wenn ich die Datei "frisch" geöffnet habe, funktioniert das ganze (aber komischerweise auch nicht immer). Führe ich das Makro jedoch mehrmals hintereinander aus, kommt der Fehler fast immer, aber das auch nicht immer an der gleichen Stelle der Schleife...
Wer kann mir helfen?
PS: Habe schon vermutet, dass die Charts die Ursache sind, aber auch ohne Charts tritt der Fehler auf.