Run-Time Error 1004 unüberwindbare Hürde
André
nach etlichen, vergeblichen Unternehmungen den "Copy Method of Worksheet Class failed" Fehler
zu beheben bzw. zu umgehen, hoffe ich, dass ihr mir helfen könnt.
Ziel ist es, eine möglichst große Zeitspanne (min. 1/2 Jahr) von täglichen Messdaten auswerten zu können. In meiner jetzigen Version kommt nach ca. 50 Tagen der Run-Time Error.
Mein Vorhaben, nach diesen 50 Tagen die Werte in eine neue Tabelle auszulagern, die alte zu schließen und in der neuen die nächsten 50 Tage einzulesen (etc.), scheitert dennoch am gleichen Fehler.
Die Anweisung des MS-Supports (http://support.microsoft.com/kb/210684/en-us) konnte ich bisher ebenfalls nicht funktionierend in das Sub Blattkopieren() einbauen. Für eure Hilfe wäre ich sehr dankbar!
Grüße André
Sub BlattKopieren()
Application.ScreenUpdating = False
Dim lngR As Long, lngLast As Long, lngFirst As Long
Dim intC As Integer
lngFirst = 13
intC = 2
With ThisWorkbook.Sheets("Dokumentation")
lngLast = Application.Max(.Cells(Rows.Count, intC).End(xlUp).Row, lngFirst)
For lngR = lngFirst To lngLast
If IsValidSheetName(.Cells(lngR, intC).Text) And Not SheetExist(.Cells(lngR, intC).Text) _
Then
ThisWorkbook.Sheets("Vorlage").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets. _
Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = .Cells(lngR, intC).Text
Range("A1").QueryTable.Connection = "TEXT;" & .Cells(lngR, 1).Text
Range("A1").QueryTable.TextFilePlatform = 850
Range("A1").QueryTable.TextFileStartRow = 1
Range("A1").QueryTable.TextFileParseType = xlDelimited
Range("A1").QueryTable.TextFileTextQualifier = xlTextQualifierDoubleQuote
Range("A1").QueryTable.TextFileConsecutiveDelimiter = False
Range("A1").QueryTable.TextFileTabDelimiter = True
Range("A1").QueryTable.TextFileSemicolonDelimiter = False
Range("A1").QueryTable.TextFileCommaDelimiter = False
Range("A1").QueryTable.TextFileSpaceDelimiter = False
Range("A1").QueryTable.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
Range("A1").QueryTable.TextFileDecimalSeparator = "."
Range("A1").QueryTable.TextFileThousandsSeparator = ","
Range("A1").QueryTable.Refresh
End If
Next
End With
Application.Run "'V_Messauswertung_automatisch1.xls'!CopyPaste"
Application.Run "'V_Messauswertung_automatisch1.xls'!cmd_WorkbookSave_Click"
End Sub
Die Applications:
Sub cmd_WorkbookSave_Click()
Sheets("Dokumentation").Select
Application.CutCopyMode = False
Range("A1:G1641").Select
Selection.Copy
Workbooks.Open Filename:=ThisWorkbook.path & "\V_Messauswertung_automatisch2.xls" '
Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _False, _
Transpose:=False
Application.CutCopyMode = False
Worksheets(1).Name = "Dokumentation"
Workbooks("V_Messauswertung_automatisch1.xls").Close SaveChanges:=False
Range("H13").Select
End Sub
Sub CopyPaste()
Dim lngRow As Long
Sheets.Add After:=Sheets("Dokumentation")
Sheets("Dokumentation").Select
lngRow = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(13, 5), Cells(lngRow, 6)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim Sh As Worksheet
Application.DisplayAlerts = False
For Each Sh In Worksheets
If Sh.Name "Sheet1" And Sh.Name "Dokumentation" Then Sh.Delete
Next Sh
Application.DisplayAlerts = True
Sheets.Add
Sheets("Sheet1").Select
Range(Cells(13, 1), Cells(lngRow, 2)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Dokumentation").Select
Range("E13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim S As Worksheet
Application.DisplayAlerts = False
For Each S In Worksheets
If S.Name "Dokumentation" Then S.Delete
Next S
Application.DisplayAlerts = True
Range("H13").Select
End Sub