Error 1004 'Copy Method of Worksheet Class failed'

 To resolve this problem, save and close the workbook periodically while the copy process is  _
occurring, as in the following sample code:
Sub CopySheetTest()
Dim iTemp As Integer
Dim oBook As Workbook
Dim iCounter As Integer
' Create a new blank workbook:
iTemp = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set oBook = Application.Workbooks.Add
Application.SheetsInNewWorkbook = iTemp
' Add a defined name to the workbook
' that RefersTo a range:
oBook.Names.Add Name:="tempRange", RefersTo:="=Sheet1!$A$1"
' Save the workbook:
oBook.SaveAs "c:\test2.xls"
' Copy the sheet in a loop. Eventually,
' you get error 1004: Copy Method of
' Worksheet class failed.
For iCounter = 1 To 275
oBook.Worksheets(1).Copy After:=oBook.Worksheets(1)
'Uncomment this code for the workaround:
'Save, close, and reopen after every 100 iterations:
If iCounter Mod 100 = 0 Then
oBook.Close SaveChanges:=True
Set oBook = Nothing
Set oBook = Application.Workbooks.Open("c:\test2.xls")
End If
Next
End Sub

Sub BlattKopieren()
Application.ScreenUpdating = False
Dim lngR As Long, lngLast As Long, lngFirst As Long
Dim intC As Integer
Dim iTemp As Integer
Dim oBook As Workbook
Dim iCounter As Integer
Dim MeineAusgabeDatei as string
MeineAusgabeDatei = "d:\My Documents\V_Messauswertung_automatisch1.xls"
Application.DisplayAlerts = False
Application.EnableEvents = False
Set oBook = Application.Workbooks.Open(MeineAusgabeDatei) //
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
// If lngr Mod 48 = 0 Then
oBook.Close SaveChanges:=True
Set oBook = Nothing
Set oBook = Application.Workbooks.Open(MeineAusgabeDatei)
End If //
Next
End With
Application.Run "'V_Messauswertung_automatisch1.xls'!CopyPaste"
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