PDA

Vollständige Version anzeigen : Neues Workbook öffnen, Worksheet rein kopieren....


roll4ever
18.07.2012, 17:36
Hallo!

Ich habe gestern die gleiche/ leicht veränderte Frage gestellt und darauf von Chris auch eine Antwort Hi
http://www.ms-office-forum.de/forum/...10&postcount=2
bsp.3 wäre das wohl. bekommen.

Leider schaffe ich es nicht das ganze auf mein mittlerweile erweitertes Problem zu erweitern :upps:.

Mein Plan ist folgender:
Ich habe ein Workbook(XYZ) das einen beliebigen Namen haben kann. In diesem Workbook gibt es unter anderem ein Worksheet(Protokoll), dass ich in ein neues Workbook(New) kopieren will und in dem alten Workbook(XYZ) löschen will. In dem neuen Workbook(New) soll jetzt nur das Worksheet(Protokoll) vorhanden sein.
Das Workbook(New) soll jetzt in einem Ordner gespeichert. Der Pfad befindet sich in dem String "Pfad", der Dateiname in dem String "Dateiname".
Befindet sich an der angegebenen Stelle nun schon eine Datei (auch .xls) mit dem gleichen Namen, muss diese geöffnet werden, eine Zelle in ihr auf einen Wert überprüft werden und dann ggf. überschrieben, oder der Vorgang abgebrochen werden.

Das ganze ist im Moment für meinen Wissensstand noch zu hoch, aber ich denke das ich das mit eurer Hilfe hinbekommen kann ;).

Vielen Dank für die (wahrscheinlich) große Mühe!

Gruß,
roll4ever

P.S. Ich hoffe das Ganze ist halbwegs verständlich!

josef e
18.07.2012, 22:03
<div style="width:98%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo ?,

soweit ich das verstanden habe und anhand deiner Infos, sollte das ungefähr so laufen.

<div style="background-color:#F5F5F5; border-width:2px; border-style: groove; border-color:#ff9966; padding:4px;"><nobr><span style="font-family:Courier New,Arial; font-size:8pt ;" ><b><span style="color:#0000FF"; >Sub</span> protokoll()</b><br />&nbsp;&nbsp;<span style="color:#0000FF"; >Dim</span> objWB <span style="color:#0000FF"; >As</span> Workbook<br />&nbsp;&nbsp;<span style="color:#0000FF"; >Dim</span> strPath <span style="color:#0000FF"; >As</span> String, strFileName <span style="color:#0000FF"; >As</span> <span style="color:#0000FF"; >String</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >Dim</span> boolContinue <span style="color:#0000FF"; >As</span> <span style="color:#0000FF"; >Boolean</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >Dim</span> lngCalc <span style="color:#0000FF"; >As</span> <span style="color:#0000FF"; >Long</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >On</span> <span style="color:#0000FF"; >Error</span> <span style="color:#0000FF"; >GoTo</span> ErrExit<br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >With</span> Application<br />&nbsp;&nbsp;&nbsp;&nbsp;.ScreenUpdating = <span style="color:#0000FF"; >False</span><br />&nbsp;&nbsp;&nbsp;&nbsp;.EnableEvents = <span style="color:#0000FF"; >False</span><br />&nbsp;&nbsp;&nbsp;&nbsp;lngCalc = .Calculation<br />&nbsp;&nbsp;&nbsp;&nbsp;.Calculation = xlCalculationManual<br />&nbsp;&nbsp;&nbsp;&nbsp;.DisplayAlerts = <span style="color:#0000FF"; >False</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >With</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;strPath = <span style="color:#808080"; >"E:\Forum"</span> <span style="color:#008000"; >'Verzeichnis</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;strFileName = <span style="color:#808080"; >"Test.xls"</span> <span style="color:#008000"; >'Dateiname</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;strPath = IIf(Right(strPath, 1) = <span style="color:#808080"; >"\"</span>, strPath, strPath & <span style="color:#808080"; >"\"</span>)<br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >If</span> Dir(strPath & strFileName, vbNormal) &lt;&gt; "" <span style="color:#0000FF"; >Then</span> <span style="color:#008000"; >'wenn Datei schon vorhanden</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >Set</span> objWB = Workbooks.Open(strPath & strFileName) <span style="color:#008000"; >'&ouml;ffnen</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >If</span> objWB.Sheets(<span style="color:#808080"; >"Tabelle1"</span>).Range(<span style="color:#808080"; >"A1"</span>) = 1 <span style="color:#0000FF"; >Then</span> <span style="color:#008000"; >'wenn Wert in A1 = 1</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;objWB.Close <span style="color:#0000FF"; >False</span> <span style="color:#008000"; >'schlie&szlig;en</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;boolContinue = <span style="color:#0000FF"; >True</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Kill strPath & strFileName <span style="color:#008000"; >'l&ouml;schen</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >If</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >Else</span><br />&nbsp;&nbsp;&nbsp;&nbsp;boolContinue = <span style="color:#0000FF"; >True</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >If</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >If</span> boolContinue <span style="color:#0000FF"; >Then</span> <span style="color:#008000"; >'wenn fortfahren</span><br />&nbsp;&nbsp;&nbsp;&nbsp;ThisWorkbook.Sheets(<span style="color:#808080"; >"Protokoll"</span>).Move <span style="color:#008000"; >'Tabelle 'Protokoll' verschieben</span><br />&nbsp;&nbsp;&nbsp;&nbsp;ActiveWorkbook.SaveAs strPath & strFileName, FileFormat:=56 <span style="color:#008000"; >'Datei speichern</span><br />&nbsp;&nbsp;&nbsp;&nbsp;ActiveWorkbook.Close <span style="color:#008000"; >'Datei schlie&szlig;en</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >If</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;ErrExit:<br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >With</span> Err<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >If</span> .Number &lt;&gt; 0 <span style="color:#0000FF"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;MsgBox <span style="color:#808080"; >"Fehler in Prozedur:"</span> & vbTab & <span style="color:#808080"; >"'protokoll'"</span> & vbLf & <span style="color:#0000FF"; >String</span>(60, <span style="color:#808080"; >"_"</span>) & _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vbLf & vbLf & IIf(Erl, <span style="color:#808080"; >"Fehler in Zeile:"</span> & vbTab & Erl & vbLf & vbLf, "") & _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#808080"; >"Fehlernummer:"</span> & vbTab & .Number & vbLf & vbLf & <span style="color:#808080"; >"Beschreibung:"</span> & vbTab & _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#808080"; >"VBA - Fehler in Modul - Modul1"</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Clear<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >If</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >With</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >On</span> <span style="color:#0000FF"; >Error</span> <span style="color:#0000FF"; >GoTo</span> 0<br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >With</span> Application<br />&nbsp;&nbsp;&nbsp;&nbsp;.ScreenUpdating = <span style="color:#0000FF"; >True</span><br />&nbsp;&nbsp;&nbsp;&nbsp;.EnableEvents = <span style="color:#0000FF"; >True</span><br />&nbsp;&nbsp;&nbsp;&nbsp;.Calculation = lngCalc<br />&nbsp;&nbsp;&nbsp;&nbsp;.DisplayAlerts = <span style="color:#0000FF"; >True</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >With</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >Set</span> objWB = <span style="color:#0000FF"; >Nothing</span><br /><b><span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >Sub</span></b><br /><br /><br /></span></nobr></div>


</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

roll4ever
19.07.2012, 06:42
Hallo Sepp,

vielen Dank für die Antwort!
:)
Werde das ganze heute mal ausprobieren und Feedback geben!

Viele Grüße,

roll4ever

roll4ever
19.07.2012, 15:07
Hallo Sepp,

der Code läuft soweit ganz gut, allerdings bekomme ich beim speichern die Fehlermeldung 1004 Die Methode 'Save As' für das Objekt '_Worksheet' ist fehlgeschlagen.

Das ganze habe ich jetzt mit folgendem im Netz gefundenen Code versucht zu umgehen:

'Pfad zum Verzeichnis einlesen
Pfad = .Range("T3").Value
Dateiname = .Range("T4").Value
Dateiname = Dateiname & ".xls"

End With

Pfad = IIf(Right(Pfad, 1) = "\", Pfad, Pfad & "\")

If Dir(Pfad & Dateiname, vbNormal) <> "" Then 'wenn Datei schon vorhanden
Set existierendesWorkbook = Workbooks.Open(Pfad & Dateiname) 'öffnen
If existierendesWorkbook.Sheets("Wickelprotokoll").Range("Z18").Value = 1 Then 'wenn = 1, dann nicht überschreiben
existierendesWorkbook.Close False
Continue = False
Kill Pfad & Dateiname 'löschen
End If
Else
Continue = True
End If

If Continue Then 'wenn fortfahren
ThisWorkbook.Sheets("Wickelprotokoll").Move 'Tabellenblatt "Wickelprotokoll" verschieben
ActiveWorkbook.SaveAs Pfad & Dateiname, FileFormat:=IIf(Val(Application.Version) > 11, 56, xlNormal) 'Datei speichern
ActiveWorkbook.Close 'Datei "Wickelprotokoll" schließen
End If


Allerdings hängt sich Excel jetzt immer auf! Wo liegt da der Fehler?

Außerdem will ich das verschobene Worksheet("Wickelprotokoll") mit einem Passwort versehen:

ActiveSheet.Protect password:="Test"
auch das klappt nicht!

Vielen Dank für die Hilfe!!!

Gruß,
roll4ever

josef e
19.07.2012, 17:19
<div style="width:98%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo ??,

poste bitte immer den gesamten Code, im ersten With-Rahmen fehlt der Beginn, siehe Code.

<div style="background-color:#F5F5F5; border-width:2px; border-style: groove; border-color:#ff9966; padding:4px;"><nobr><span style="font-family:Courier New,Arial; font-size:8pt ;" ><span style="color:#008000"; >' **********************************************************************</span><br /><span style="color:#008000"; >' Modul: Modul1 Typ: Allgemeines Modul</span><br /><span style="color:#008000"; >' **********************************************************************</span><br /><br /><span style="color:#0000FF"; >Option</span> <span style="color:#0000FF"; >Explicit</span><br /><br /><b><span style="color:#0000FF"; >Sub</span> protokoll()</b><br />&nbsp;&nbsp;<span style="color:#0000FF"; >Dim</span> objWB <span style="color:#0000FF"; >As</span> Workbook<br />&nbsp;&nbsp;<span style="color:#0000FF"; >Dim</span> strPath <span style="color:#0000FF"; >As</span> String, strFileName <span style="color:#0000FF"; >As</span> <span style="color:#0000FF"; >String</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >Dim</span> strExt <span style="color:#0000FF"; >As</span> String, lngF <span style="color:#0000FF"; >As</span> <span style="color:#0000FF"; >Long</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >Dim</span> boolContinue <span style="color:#0000FF"; >As</span> <span style="color:#0000FF"; >Boolean</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >Dim</span> lngCalc <span style="color:#0000FF"; >As</span> <span style="color:#0000FF"; >Long</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >On</span> <span style="color:#0000FF"; >Error</span> <span style="color:#0000FF"; >GoTo</span> ErrExit<br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >With</span> Application<br />&nbsp;&nbsp;&nbsp;&nbsp;.ScreenUpdating = <span style="color:#0000FF"; >False</span><br />&nbsp;&nbsp;&nbsp;&nbsp;.EnableEvents = <span style="color:#0000FF"; >False</span><br />&nbsp;&nbsp;&nbsp;&nbsp;lngCalc = .Calculation<br />&nbsp;&nbsp;&nbsp;&nbsp;.Calculation = xlCalculationManual<br />&nbsp;&nbsp;&nbsp;&nbsp;.DisplayAlerts = <span style="color:#0000FF"; >False</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >With</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#008000"; >'Achtung!</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >With</span> Sheets(<span style="color:#808080"; >"?"</span>) <span style="color:#008000"; >'Tabellenname unbekannt!</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#008000"; >'Pfad zum Verzeichnis einlesen</span><br />&nbsp;&nbsp;&nbsp;&nbsp;Pfad = .Range(<span style="color:#808080"; >"T3"</span>).Text<br />&nbsp;&nbsp;&nbsp;&nbsp;Dateiname = .Range(<span style="color:#808080"; >"T4"</span>).Text<br />&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >With</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<br />&nbsp;&nbsp;strPath = IIf(Right(strPath, 1) = <span style="color:#808080"; >"\"</span>, strPath, strPath & <span style="color:#808080"; >"\"</span>)<br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >If</span> Dir(strPath & strFileName, vbNormal) &lt;&gt; "" <span style="color:#0000FF"; >Then</span> <span style="color:#008000"; >'wenn Datei schon vorhanden</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >Set</span> objWB = Workbooks.Open(strPath & strFileName) <span style="color:#008000"; >'&ouml;ffnen</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >If</span> objWB.Sheets(<span style="color:#808080"; >"Tabelle1"</span>).Range(<span style="color:#808080"; >"A1"</span>) = 1 <span style="color:#0000FF"; >Then</span> <span style="color:#008000"; >'wenn Wert in A1 = 1</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;objWB.Close <span style="color:#0000FF"; >False</span> <span style="color:#008000"; >'schlie&szlig;en</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;boolContinue = <span style="color:#0000FF"; >True</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Kill strPath & strFileName <span style="color:#008000"; >'l&ouml;schen</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >If</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >Else</span><br />&nbsp;&nbsp;&nbsp;&nbsp;boolContinue = <span style="color:#0000FF"; >True</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >If</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >If</span> boolContinue <span style="color:#0000FF"; >Then</span> <span style="color:#008000"; >'wenn fortfahren</span><br />&nbsp;&nbsp;&nbsp;&nbsp;ThisWorkbook.Sheets(<span style="color:#808080"; >"Wickelprotokoll"</span>).Move <span style="color:#008000"; >'Tabelle 'Protokoll' verschieben</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >Set</span> objWB = ActiveWorkbook<br />&nbsp;&nbsp;&nbsp;&nbsp;getFileExtAndFormat objWB, strExt, lngF <span style="color:#008000"; >'Dateierweiterung und Format ermitteln</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >With</span> objWB<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Sheets(1).Protect <span style="color:#808080"; >"test"</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.SaveAs strPath & strFileName & strExt, FileFormat:=lngF <span style="color:#008000"; >'Datei speichern</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Close <span style="color:#008000"; >'Datei schlie&szlig;en</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >With</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >If</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;ErrExit:<br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >With</span> Err<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >If</span> .Number &lt;&gt; 0 <span style="color:#0000FF"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;MsgBox <span style="color:#808080"; >"Fehler in Prozedur:"</span> & vbTab & <span style="color:#808080"; >"'protokoll'"</span> & vbLf & <span style="color:#0000FF"; >String</span>(60, <span style="color:#808080"; >"_"</span>) & _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vbLf & vbLf & IIf(Erl, <span style="color:#808080"; >"Fehler in Zeile:"</span> & vbTab & Erl & vbLf & vbLf, "") & _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#808080"; >"Fehlernummer:"</span> & vbTab & .Number & vbLf & vbLf & <span style="color:#808080"; >"Beschreibung:"</span> & vbTab & _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#808080"; >"VBA - Fehler in Modul - Modul1"</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Clear<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >If</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >With</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >On</span> <span style="color:#0000FF"; >Error</span> <span style="color:#0000FF"; >GoTo</span> 0<br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >With</span> Application<br />&nbsp;&nbsp;&nbsp;&nbsp;.ScreenUpdating = <span style="color:#0000FF"; >True</span><br />&nbsp;&nbsp;&nbsp;&nbsp;.EnableEvents = <span style="color:#0000FF"; >True</span><br />&nbsp;&nbsp;&nbsp;&nbsp;.Calculation = lngCalc<br />&nbsp;&nbsp;&nbsp;&nbsp;.DisplayAlerts = <span style="color:#0000FF"; >True</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >With</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#0000FF"; >Set</span> objWB = <span style="color:#0000FF"; >Nothing</span><br /><b><span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >Sub</span></b><br /><br /><br /><b><span style="color:#0000FF"; >Private</span> <span style="color:#0000FF"; >Function</span> getFileExtAndFormat(<span style="color:#0000FF"; >ByRef</span> WB <span style="color:#0000FF"; >As</span> Workbook, <span style="color:#0000FF"; >ByRef</span> strExt <span style="color:#0000FF"; >As</span> String, <span style="color:#0000FF"; >ByRef</span> lngFormat <span style="color:#0000FF"; >As</span> <span style="color:#0000FF"; >Long</span>)</b><br />&nbsp;&nbsp;<span style="color:#0000FF"; >With</span> WB<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >If</span> Val(Application.Version) &lt; 12 <span style="color:#0000FF"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;strExt = <span style="color:#808080"; >".xls"</span>: lngFormat = -4143<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >Else</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >Select</span> <span style="color:#0000FF"; >Case</span> WB.FileFormat<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >Case</span> 51: strExt = <span style="color:#808080"; >".xlsx"</span>: lngFormat = 51<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >Case</span> 52:<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >If</span> .HasVBProject <span style="color:#0000FF"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;strExt = <span style="color:#808080"; >".xlsm"</span>: lngFormat = 52<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >Else</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;strExt = <span style="color:#808080"; >".xlsx"</span>: lngFormat = 51<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >If</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >Case</span> 56: strExt = <span style="color:#808080"; >".xls"</span>: lngFormat = 56<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >Case</span> Else: strExt = <span style="color:#808080"; >".xlsb"</span>: lngFormat = 50<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >Select</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >If</span><br />&nbsp;&nbsp;<span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >With</span><br /><b><span style="color:#0000FF"; >End</span> <span style="color:#0000FF"; >Function</span></b><br /><br /></span></nobr></div>


</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

roll4ever
20.07.2012, 07:50
Hallo Sepp,

vielen Dank für deine Hilfe.

Ich kann deinen Code leider nicht vollständig testen, da mein Excel immer an der Stelle
ThisWorkbook.Sheets("Wickelprotokoll").Move
den Geist aufgibt und sich selbst beendet. Ich verwende Excel2003, falls das weiterhilft.

Bin ein bißchen am Verzweifeln!!!:mad:

Grüße,
roll4ever

roll4ever
20.07.2012, 13:25
Hallo,

eine weitere Anmerkung. Wenn ich den Code Zeilenweise durchgehe kriege ich an besagter Stelle immer die Meldung:

Wechsel in den Haltemodus ist zu diesem Zeitpunkt nicht möglich.

Ich schätze das das etwas mit dem Kopieren zu tun hat, da man dabei ja nicht stoppen kann. Aber vielleicht hilft es ja irgendjemandem sonst weiter!

Gruß,
roll4ever

josef e
20.07.2012, 17:55
<div style="width:98%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo ???, (verschweigst ganz schön hartnäckig deinen Namen!)


sorry, ein Lapsus meinerseits, es muss statt .Move natürlich .Copy heißen.

</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

roll4ever
25.07.2012, 12:52
Hallo Sepp,

vielen Dank für die Info.

Setze es dann mal gleich um und hoffe auf keine neuen Schwierigkeiten!!

Vielen Dank und mit ziemlicher Sicherheit bis bald,

Claas :grins:

Schöne Woche noch!!!

roll4ever
26.07.2012, 12:05
Hallo Sepp und natürlich auch alle anderen!

Wie gestern angekündigt ist hier schon meine nächste Frage:

Ich habe meinen Code um Folgende Zeilen erweitert:
If Continue Then 'wenn fortfahren
ThisWorkbook.Sheets("Wickelprotokoll").Copy 'Tabellenblatt "Wickelprotokoll" verschieben
Set NewWB = ActiveWorkbook
getDateiendungundDateiformat NewWB, Dateiendung, Dateiformat 'Dateierweiterung und Dateiformat ermitteln
With NewWB
.Sheets(1).Protect "test"
.SaveAs Pfad & Dateiname & Dateiendung, FileFormat:=Dateiformat 'Datei speichern
.Close 'Datei "Wickelprotokoll" schließen
End With
End If

With ActiveWorkbook
Worksheets("Wickelauftrag").Activate
Worksheets("Wickelprotokoll").Delete
End With

'########################
ErrExit:

With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "Zellen_sperren_entsperren" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Modul - Online_Wickelprotokoll"
.Clear
End If
End With

On Error GoTo 0
'########################

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = Calc
.DisplayAlerts = True
.ScreenUpdating = True
End With
ActiveSheet.Protect

und habe jetzt wieder das Problem, dass Excel an der entsprechenden Stelle abstürzt. Öffnen ich die Datei nun mit Wiederherstell-Funktion ist das Sheet("Wickelprotokoll") gelöscht und das Sheet("Wickelauftrag") aktiv, so wie ich es wollte.

Woran kann denn diese nervige Abstürzerei liegen?
Ohne die Codezeilen läuft das Makro sauber durch.

Vielen Dank für eure Hilfe!!

josef e
26.07.2012, 17:43
<div style="width:98%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo Claas,

ohne Punkte ist der With-Rahmen sinnlos!


Versuche es so.

<pre>
With ThisWorkbook
.Sheets("Wickelauftrag").Activate
.Sheets("Wickelprotokoll").Delete
End With
</pre>

</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

roll4ever
27.07.2012, 07:02
Hallo Sepp,

Vielen Dank für den Tipp.
Jetzt scheint Excel nicht mehr abzustürzen, ich bekomme allerdings an der Stelle:
With ThisWorkbook
.Sheets("Wickelauftrag").Activate
.Sheets("Wickelprotokoll").Delete
End With
die angehängte Fehlermeldung aus.

Kannst du mir da auch weiterhelfen? Habe im Netz noch keine passende Beschreibung oder Lösung zur Fehlermeldung 40040 gefunden.

roll4ever
27.07.2012, 07:26
Hallo Sepp,

ich glaube mittlerweile nicht mehr das es an den im vorigen Beitrag beschriebenen Zellen liegt :( . Allerdings weiß ich auch nicht wo sonst. Was bräuchtest du/ihr denn um eventuell gezielter zu helfen?

Vielen Dank für die Anstrengungen!

josef e
27.07.2012, 18:42
<div style="width:98%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo Claas,

<i>"Was bräuchtest du/ihr denn um eventuell gezielter zu helfen?"</i>

Du solltest den gesamten Code posten und nicht nur Fragmente!

Was zur Hölle ist z.B. "Zellen_sperren_entsperren" ?
</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

roll4ever
30.07.2012, 09:14
Hallo Sepp,

hier der gesamte Code:


Private Sub Zellen_sperren_entsperren()

'########################
'falls ein Fehler auftritt gehe zur Fehlerbehandlung
On Error GoTo ErrExit
'########################

Dim NewWB As Object 'neu erstelltes Workbook mit Sheet("Wickelprotokoll")
Dim existierendesWB As Object 'das eventuell unter dem Pfad mit gleichem Dateinamen schon befindliche Workbook
Dim Continue As Boolean
Dim Schalter As Button
Dim Pfad As String 'Pfad zum Verzeichnis
Dim Dateiname As String 'Dateiname
Dim Dateiendung As String
Dim Dateiformat As Long
Dim Calc As Long
Dim wsWi As Worksheet
Set wsWi = Worksheets("Wickelauftrag")
Dim wsWp As Worksheet
Set wsWp = Worksheets("Wickelprotokoll")

With Application
.ScreenUpdating = False
.EnableEvents = False
Calc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With

With wsWp

LetzteSpalte = .Cells(34, .Columns.Count).End(xlToLeft).Column
LetzteZeile = .Cells(.Rows.Count, LetzteSpalte).End(xlUp).Row
.Range(.Cells(14, 1), .Cells(LetzteZeile + 23, LetzteSpalte)).Interior.ColorIndex = xlNone 'entfärbt sämtliche Zellen im Wickelprotokoll
.Range(.Cells(14, 1), .Cells(LetzteZeile + 23, LetzteSpalte)).Locked = True 'setzt alle Zellen auf "Gesperrt"

'färbt alle Spalten in denen die Wickler Werte eintragen müssen ROT und
'entsperrt die Bereiche in denen die Wickler Werte eintragen müssen
Spindelanzahl = .Range("C19").Value
LetzteZeile = .Cells(.Rows.Count, 1).End(xlUp).Row

.Range(.Cells(37, 6), .Cells(LetzteZeile, 7)).Interior.ColorIndex = 22 'Spalten "F" und "G"
.Range(.Cells(37, 6), .Cells(LetzteZeile, 7)).Locked = False

.Range(.Cells(37, 18), .Cells(LetzteZeile, 19 + Spindelanzahl - 1)).Interior.ColorIndex = 22 'Spalten "R" bis "S" + Spindelanzahl - 1
.Range(.Cells(37, 18), .Cells(LetzteZeile, 19 + Spindelanzahl - 1)).Locked = False

.Range(.Cells(37, 21 + Spindelanzahl - 1), .Cells(LetzteZeile, 21 + Spindelanzahl - 1)).Interior.ColorIndex = 22 'Spalte "U" + Spindelanzahl - 1
.Range(.Cells(37, 21 + Spindelanzahl - 1), .Cells(LetzteZeile, 21 + Spindelanzahl - 1)).Locked = False

.Range(.Cells(37, 23 + Spindelanzahl - 1), .Cells(LetzteZeile, 26 + Spindelanzahl - 1)).Interior.ColorIndex = 22 'Spalte "W" + Spindelanzahl - 1 bis "Z" .Range(.Cells(37, 21 + Spindelanzahl - 1), .Cells(LetzteZeile, 21 + Spindelanzahl - 1)).Interior.ColorIndex = 22 'Spalte "U" + Spindelanzahl - 1
.Range(.Cells(37, 23 + Spindelanzahl - 1), .Cells(LetzteZeile, 26 + Spindelanzahl - 1)).Locked = False

LetzteZeile = .Cells(.Rows.Count, LetzteSpalte).End(xlUp).Row
.Range(.Cells(LetzteZeile + 4, 20), .Cells(LetzteZeile + 23, 20)).Interior.ColorIndex = 22 'Spalte "T" in "Harzverbrauch gesamt"
.Range(.Cells(LetzteZeile + 4, 20), .Cells(LetzteZeile + 23, 20)).Locked = False

'färbt alle Spalten aus denen die Wickler Werte in IFS übernehmen müssen GRÜN
.Range(.Cells(LetzteZeile + 4, 2), .Cells(LetzteZeile + 23, 5)).Interior.ColorIndex = 35
.Range(.Cells(LetzteZeile + 4, 7), .Cells(LetzteZeile + 23, 12)).Interior.ColorIndex = 35

'färbt Zellen im Kopf des Wickelauftrags/Wickelprotokolls auf die geachtet werden sollte GELB
.Range("C18:C19,M15:M16,I18,C25,C26,L25,L26,L24,K22,A28,J28").Interior.ColorIndex = 6
If .Range("K23").Value <> "" Then .Range("K23").Interior.ColorIndex = 6
If .Range("Q18").Value <> "" Then .Range("Q18").Interior.ColorIndex = 6

'löscht Buttons die von den Wicklern nicht benötigt werden
For Each Schalter In wsWp.Buttons
If Schalter.Name <> "Mengen_berechnen" And Schalter.Name <> "Wickelprotokoll_speichern" Then Schalter.Delete
Next Schalter


'Pfad zum Verzeichnis einlesen
Pfad = .Range("T3").Value
Dateiname = .Range("T4").Value

End With

getDateiendungundDateiformat NewWB, Dateiendung, Dateiformat 'Dateierweiterung und Dateiformat ermitteln
Pfad = IIf(Right(Pfad, 1) = "\", Pfad, Pfad & "\")

If Dir(Pfad & Dateiname & Dateiendung, vbNormal) <> "" Then 'wenn Datei schon vorhanden
Set existierendesWB = Workbooks.Open(Pfad & Dateiname) 'öffnen
If existierendesWB.Sheets("Wickelprotokoll").Range("Kontrollfeld_speichern").Value = 1 Then 'wenn = 1, dann nicht überschreiben
existierendesWB.Close False
Continue = False
Kill Pfad & Dateiname 'löschen
End If
Else
Continue = True
End If

If Continue Then 'wenn fortfahren
ThisWorkbook.Sheets("Wickelprotokoll").Copy 'Tabellenblatt "Wickelprotokoll" verschieben
Set NewWB = ActiveWorkbook
With NewWB
.Sheets(1).Protect "test"
.SaveAs Pfad & Dateiname & Dateiendung, FileFormat:=Dateiformat 'Datei speichern
.Close 'Datei "Wickelprotokoll" schließen
End With
End If

With ThisWorkbook
.Sheets("Wickelauftrag").Activate
.Sheets("Wickelprotokoll").Delete
End With

'########################
ErrExit:

MsgBox Erl

With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "Zellen_sperren_entsperren" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Modul - Online_Wickelprotokoll"
.Clear
End If
End With

On Error GoTo 0
'########################

With Application
.EnableEvents = True
.Calculation = Calc
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.ScreenUpdating = True
End With

Set NewWB = Nothing

End Sub


Das Sub wird aus:

Sub Button_Online_TuWi_erstellen()

Dim wsWp As Worksheet
Dim wsWi As Worksheet
Set wsWi = Worksheets("Wickelauftrag")

Call Anzahl_Harzsysteme_bestimmen
Call Button_Leere_Zeilen_ausblenden

Application.ScreenUpdating = False
ActiveSheet.Unprotect

wsWi.Copy after:=Sheets(Worksheets.Count)
ActiveSheet.Name = "Wickelprotokoll"

With ActiveSheet
.UsedRange.Cells.Value = wsWi.UsedRange.Cells.Value
.Range("Kontrollfeld_Makro").Value = 1
End With

Call Zellen_sperren_entsperren

wsWi.Protect

End Sub

durch drücken eines Buttons aufgerufen.

Vielen Dank für dein Angagement obwohl es mit mir doch recht zäh voran geht.:eek:

roll4ever
02.08.2012, 14:55
Hallo alle Helfenden, hallo Sepp,

ich habe meinen Code noch etwas erweitert und ein weiteres Makro eingebaut, sowie ein Calculate eingefügt. Ich bekomme zwar immernoch die unten angehängete Fehlermeldung, Excel stürzt aber auch nach mehrmaligem Durchlauf nicht mehr ab. Wenn ich einfch nur die auskommentierte Pause verwenden, stürzt mir Excel wieder ab.

Private Sub Zellen_sperren_entsperren()

'########################
'falls ein Fehler auftritt gehe zur Fehlerbehandlung
On Error GoTo ErrHandler
'########################

Dim NewWB As Object 'neu erstelltes Workbook mit Sheet("Wickelprotokoll")
Dim existierendesWB As Object 'das eventuell unter dem Pfad mit gleichem Dateinamen schon befindliche Workbook
Dim Continue As Boolean
Dim Schalter As Button
Dim Pfad As String 'Pfad zum Verzeichnis
Dim Dateiname As String 'Dateiname
Dim Dateiendung As String
Dim Dateiformat As Long
Dim Calc As Long
Dim wsPf As Worksheet
Set wsPf = Worksheets("Pfad")
Dim wsWi As Worksheet
Set wsWi = Worksheets("Wickelauftrag")
Dim wsWp As Worksheet
Set wsWp = Worksheets("Wickelprotokoll")

With Application
.ScreenUpdating = False
.EnableEvents = False
Calc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With

With wsWp

LetzteSpalte = .Cells(34, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(14, 1), .Cells(65536, LetzteSpalte)).Interior.ColorIndex = xlNone 'entfärbt sämtliche Zellen im Wickelprotokoll
.Range(.Cells(14, 1), .Cells(65536, LetzteSpalte)).Locked = True 'setzt alle Zellen auf "Gesperrt"

'färbt alle Spalten in denen die Wickler Werte eintragen müssen ROT und
'entsperrt die Bereiche in denen die Wickler Werte eintragen müssen
Spindelanzahl = .Range("C19").Value
LetzteZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(LetzteZeile + 1, 3).Value <> "" Then 'Hybridband
LetzteZeile = LetzteZeile + 1
End If

.Range(.Cells(37, 6), .Cells(LetzteZeile, 7)).Interior.ColorIndex = 22 'Spalten "F" und "G"
.Range(.Cells(37, 6), .Cells(LetzteZeile, 7)).Locked = False

.Range(.Cells(37, 18), .Cells(LetzteZeile, 19 + Spindelanzahl - 1)).Interior.ColorIndex = 22 'Spalten "R" bis "S" + Spindelanzahl - 1
.Range(.Cells(37, 18), .Cells(LetzteZeile, 19 + Spindelanzahl - 1)).Locked = False

.Range(.Cells(37, 21 + Spindelanzahl - 1), .Cells(LetzteZeile, 21 + Spindelanzahl - 1)).Interior.ColorIndex = 22 'Spalte "U" + Spindelanzahl - 1
.Range(.Cells(37, 21 + Spindelanzahl - 1), .Cells(LetzteZeile, 21 + Spindelanzahl - 1)).Locked = False

.Range(.Cells(37, 23 + Spindelanzahl - 1), .Cells(LetzteZeile, 26 + Spindelanzahl - 1)).Interior.ColorIndex = 22 'Spalte "W" + Spindelanzahl - 1 bis "Z" .Range(.Cells(37, 21 + Spindelanzahl - 1), .Cells(LetzteZeile, 21 + Spindelanzahl - 1)).Interior.ColorIndex = 22 'Spalte "U" + Spindelanzahl - 1
.Range(.Cells(37, 23 + Spindelanzahl - 1), .Cells(LetzteZeile, 26 + Spindelanzahl - 1)).Locked = False

LetzteZeile = .Cells(.Rows.Count, LetzteSpalte).End(xlUp).Row
.Range(.Cells(LetzteZeile + 4, 20), .Cells(LetzteZeile + 23, 20)).Interior.ColorIndex = 22 'Spalte "T" in "Harzverbrauch gesamt"
.Range(.Cells(LetzteZeile + 4, 20), .Cells(LetzteZeile + 23, 20)).Locked = False

'färbt alle Spalten aus denen die Wickler Werte in IFS übernehmen müssen GRÜN
.Range(.Cells(LetzteZeile + 4, 2), .Cells(LetzteZeile + 23, 5)).Interior.ColorIndex = 35
.Range(.Cells(LetzteZeile + 4, 7), .Cells(LetzteZeile + 23, 12)).Interior.ColorIndex = 35

'färbt Zellen im Kopf des Wickelauftrags/Wickelprotokolls auf die geachtet werden sollte GELB
.Range("C18:C19,M15:M16,I18,C25,C26,L25,L26,L24,K22,A28,K28,Q18").Interior.ColorIndex = 6
If .Range("K23").Value <> "" Then .Range("K23").Interior.ColorIndex = 6

'löscht Buttons die von den Wicklern nicht benötigt werden
For Each Schalter In wsWp.Buttons
If Schalter.Name <> "Mengen_berechnen" And Schalter.Name <> "Wickelprotokoll_speichern" Then Schalter.Delete
Next Schalter

'Pfad zum Verzeichnis einlesen
'Pfad = wspf.Range("A25").Value
Pfad = .Range("T3").Value

End With

getDateiendungundDateiformat NewWB, Dateiendung, Dateiformat 'Dateierweiterung und Dateiformat ermitteln
Pfad = IIf(Right(Pfad, 1) = "\", Pfad, Pfad & "\")

If Dir(Pfad & Dateiname & Dateiendung, vbNormal) <> "" Then 'wenn Datei schon vorhanden
Set existierendesWB = Workbooks.Open(Pfad & Dateiname) 'öffnen
If existierendesWB.Sheets("Wickelprotokoll").Range("Kontrollfeld_speichern").Value = 1 Then 'wenn = 1, dann nicht überschreiben
existierendesWB.Close False
Continue = False
Kill Pfad & Dateiname 'löschen
End If
Else
Continue = True
End If

If Continue Then 'wenn fortfahren
For i = 1 To 2
Dateiname = wsWi.Range("T4").Value & "_" & i
ThisWorkbook.Sheets("Wickelprotokoll").Copy 'Tabellenblatt "Wickelprotokoll" verschieben
Set NewWB = ActiveWorkbook
With NewWB
.Sheets(1).Protect "test"
.SaveAs Pfad & Dateiname & Dateiendung, FileFormat:=Dateiformat 'Datei speichern
' .Close 'Datei "Wickelprotokoll" schließen
End With

Call WriteMakro

With NewWB
.Save
.Close 'Datei "Wickelprotokoll" schließen
End With
Next i
End If

Calculate
'Application.Wait Now + TimeSerial(0, 0, 1)

With ThisWorkbook
.Sheets("Wickelprotokoll").Delete
.Sheets("Wickelauftrag").Activate
End With

'########################
ErrHandler:

With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "Zellen_sperren_entsperren" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Modul - Online_Wickelprotokoll"
.Clear
End If
End With

On Error GoTo 0
'########################

With Application
.EnableEvents = True
.Calculation = Calc
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.ScreenUpdating = True
End With

Set NewWB = Nothing

End Sub


Das Ergebnis ist also nicht ganz befriedigend, aber ein Fortschritt!

Vielen Dank für deine Hilfe Sepp!!!
Ohne dich wäre ich nicht so weit gekommen!!!

Ich habe noch einiges zu tun an dem Code, deswegen würde ich das Thema noch offen lassen.