PDA

Vollständige Version anzeigen : copy-methode des worksheet-objektes konnte nicht ausgeführt werden


Petz2312
30.08.2017, 13:28
Hallo zusammen,

ich habe schon einiges zum Thema "copy-methode des worksheet-objektes konnte nicht ausgeführt werden" in diversen Foren gelesen, doch dabei leider keine Lösung für mein Problem gefunden :-(

Seit einigen Jahren verwende ich ein Makro und seit kurzen kommt in unregelmäßigen Abständen folgende Fehlermeldung: "Laufzeitfehler 1004 - copy-methode des worksheet-objektes konnte nicht ausgeführt werden"
Wenn ich dann debugge, komme ich zur Stelle "Sheets("Offert").Copy after:=Worksheets(Worksheets.Count)". Mit F8 kann ich dann weiter debuggen und das Makro läuft problemlos fertig.

Da die Fehlermeldung wie gesagt einmal kommt, dann wieder fünfmal nicht, bin ich echt am Verzweifeln :-(

Danke euch schon mal im Voraus für eure Unterstützung!!!

LG
Petz2312

Hasso
30.08.2017, 17:29
Hallo Petz2312,

ohne dass du uns deinen kompletten Code zeigst oder die Mappe hochlädst sind deine Aussichten auf Unterstützung eher gering...

Muller
30.08.2017, 17:40
Hallo,

füg mal nach dem Copy-Befehl ein DoEvents ein, andernfalls gilt Hasso's Hinweis....

Gruß, Muller

Petz2312
31.08.2017, 05:23
Hallo,

Danke für euren Hinweis.
Hier der Code. Bei Bedarf kann ich auch die Mappe hochladen.


Option Explicit

Dim offertnr As Integer

Sub Offert_erstellen()
Dim blatt As Object
If Eingabe.Cells(46, 1) = "" And Eingabe.Cells(47, 1) = "" And Eingabe.Cells(48, 1) = "" Then
'Application.Calculate
'Do While Application.CalculationState <> xlDone
' If Application.CalculationState = xlPending Then
' Application.Calculate
' End If
' DoEvents
'Loop
Application.ScreenUpdating = False
Application.DisplayAlerts = False
offertnr = Int(Datenschnittstelle.Cells(18, 5))
Archiv.Cells(offertnr + 1, 1) = offertnr
Archiv.Cells(offertnr + 1, 2) = Eingabe.Cells(8, 2)
Archiv.Cells(offertnr + 1, 3) = Eingabe.Cells(9, 2)
Archiv.Cells(offertnr + 1, 4) = Eingabe.Cells(10, 2)
Archiv.Cells(offertnr + 1, 5) = Eingabe.Cells(11, 2)
Archiv.Cells(offertnr + 1, 6) = Eingabe.Cells(12, 2)
Archiv.Cells(offertnr + 1, 25) = Eingabe.Cells(13, 2)
Archiv.Cells(offertnr + 1, 38) = Eingabe.Cells(14, 2)
Archiv.Cells(offertnr + 1, 39) = Eingabe.Cells(15, 2)
Archiv.Cells(offertnr + 1, 40) = Eingabe.Cells(16, 2)
Archiv.Cells(offertnr + 1, 41) = Eingabe.Cells(17, 2)
Archiv.Cells(offertnr + 1, 13) = Eingabe.Cells(19, 2)
Archiv.Cells(offertnr + 1, 11) = Eingabe.Cells(20, 2)
Archiv.Cells(offertnr + 1, 12) = Eingabe.Cells(21, 2)
Archiv.Cells(offertnr + 1, 10) = Eingabe.Cells(22, 2)
Archiv.Cells(offertnr + 1, 9) = Eingabe.Cells(23, 2)
Archiv.Cells(offertnr + 1, 33) = Eingabe.Cells(24, 2)
Archiv.Cells(offertnr + 1, 34) = Eingabe.Cells(25, 2)
Archiv.Cells(offertnr + 1, 35) = Eingabe.Cells(26, 2)
Archiv.Cells(offertnr + 1, 14) = Eingabe.Cells(28, 2)
Archiv.Cells(offertnr + 1, 28) = Eingabe.Cells(29, 2)
Archiv.Cells(offertnr + 1, 17) = Eingabe.Cells(30, 2)
Archiv.Cells(offertnr + 1, 18) = Eingabe.Cells(31, 2)
Archiv.Cells(offertnr + 1, 19) = Eingabe.Cells(32, 2)
Archiv.Cells(offertnr + 1, 16) = Eingabe.Cells(33, 2)
Archiv.Cells(offertnr + 1, 15) = Eingabe.Cells(34, 2)
Archiv.Cells(offertnr + 1, 21) = Eingabe.Cells(35, 2)
Archiv.Cells(offertnr + 1, 26) = Eingabe.Cells(36, 2)
Archiv.Cells(offertnr + 1, 20) = Eingabe.Cells(37, 2)
Archiv.Cells(offertnr + 1, 24) = Eingabe.Cells(38, 2)
Archiv.Cells(offertnr + 1, 32) = Eingabe.Cells(39, 2)
Archiv.Cells(offertnr + 1, 30) = Eingabe.Cells(40, 2)
Archiv.Cells(offertnr + 1, 31) = Eingabe.Cells(41, 2)
Archiv.Cells(offertnr + 1, 23) = Eingabe.Cells(42, 2)
Archiv.Cells(offertnr + 1, 29) = Eingabe.Cells(43, 2)
Archiv.Cells(offertnr + 1, 27) = "aktiv"
Sheets("Offert").Select
Sheets("Offert").Copy after:=Worksheets(Worksheets.Count) ''' HIER IST DAS PROBLEM !!!! '''''
Sheets("Offert (2)").name = "Offert " & offertnr
Sheets("Offert " & offertnr).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Zusage").Select
Sheets("Zusage").Copy after:=Worksheets(Worksheets.Count)
Sheets("Zusage (2)").name = "Zusage " & offertnr
Sheets("Zusage " & offertnr).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.DisplayAlerts = True
Datenschnittstelle.Cells(18, 5) = offertnr + 1
Datenschnittstelle.Cells(18, 4) = ""
Application.ScreenUpdating = True
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
Sheets("Input").Select
MsgBox "Offert und Zusage wurden erfolgreich erstellt :-)", vbOKOnly, "Gratuliere !!!"

Else: MsgBox "Bitte Daten vervollständigen", vbOKOnly + vbCritical, "Achtung"
End If
End Sub


Danke für eure Unterstützung!
LG Petz