Registriert seit: 17.01.2018
Version(en): 2016
17.01.2018, 13:34
(Dieser Beitrag wurde zuletzt bearbeitet: 22.01.2018, 14:16 von Rabe.
Bearbeitungsgrund: Code-Tags benutzt
)
Hallo Excel Freunde,
ich weiß nicht mehr weiter. Ich habe ein Makros geschrieben, welches die Excel Dateien aus einen "zu angegebenen" Ordner öffnet, den Inhalt (ein Tabellenblatt) kopiert und diesen in eine neue Excel Datei speichert. Also ich habe mehrere Excel Dateien mit jeweils 1 Sheet und möchte diese zu einer Excel Datei machen mit mehreren Sheets. Hier der Code:
Code:
Sub zustelLETZE()
Dim strDatnam As String
Dim wb As Workbook
Dim ws As Worksheet
Dim AnzahlTabellen As Integer
AnzahlTabellen = 1
Dim spfad As String
Dim sDatei As String
Dim dat As String
' Open the select folder prompt
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then ' if OK is pressed
dat = .SelectedItems(1)
End If
End With
spfad = (dat & "\")
strDatnam = Dir(CStr(spfad & "*.xls"))
Do While Len(strDatnam)
Set wb = Workbooks.Open(spfad & strDatnam)
Set ws = ThisWorkbook.Sheets.Add
ws.Name = AnzahlTabellen
AnzahlTabellen = AnzahlTabellen + 1
wb.Sheets(1).Cells.Copy Destination:=ws.Cells
wb.Close savechanges:=False
strDatnam = Dir
Loop
Set ws = Nothing
Set wb = Nothing
End Sub
Er speichert die Sheets in die Neue Exceldatei und erstellt dort ein Sheet beginnend mit 1 bis N (n= anzahl der Dateien im Folder).
Bei vielen Ordnern klappt dies ohne Probleme. Doch bei manchen Ordnern ( mit wenig aber auch mit vielen Dateien) kommt die Fehlermeldung "Microsoft Excel funktioniert nicht mehr" mit der Auswahl "Programm neu Starten".
Beispiel: Ich wähle ein Ordner mit 10 Dateien aus dies Funktioniert ohne Probleme. Wähle ich ein anderen Ordner mit 10 Dateien aus, kommt die Fehlermeldung. Nehme ich aus dem Ordner 7 Dateien raus und probiere das Makros bei 3 Dateien. Brauch ich manchmal 3-4 Anläufe bis es funktioniert. Also das komische ist, dass er nicht immer "abschmiert" aber zu 90%.
Woran kann das liegen? Schreibschutz sollte bei den Dateien etc. nicht vorhanden sein. Ich hoffe ihr könnt mir helfen und meine Verzweiflung brechen.
Mit freundlichen Gruß
Excel_Jürgen
Registriert seit: 11.04.2014
Version(en): Office 2007
Hallo,
ich habe mal das entsetten von den Variablen weiter nach oben gesetzt.
Code:
Sub zustelLETZE()
Dim strDatnam As String
Dim wb As Workbook
Dim ws As Worksheet
Dim AnzahlTabellen As Integer
Dim spfad As String
Dim sDatei As String
Dim dat As String
AnzahlTabellen = 1
' Open the select folder prompt
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then ' if OK is pressed
dat = .SelectedItems(1)
End If
End With
spfad = (dat & "\")
strDatnam = Dir(CStr(spfad & "*.xls"))
Do While Len(strDatnam)
Set wb = Workbooks.Open(spfad & strDatnam)
Set ws = ThisWorkbook.Sheets.Add
ws.Name = AnzahlTabellen
AnzahlTabellen = AnzahlTabellen + 1
wb.Sheets(1).Cells.Copy Destination:=ws.Cells
wb.Close savechanges:=False
Set ws = Nothing
Set wb = Nothing
strDatnam = Dir
Loop
End Sub
Gruß Stefan
Win 10 / Office 2016
Registriert seit: 12.03.2016
Version(en): Excel 2003/ 2016
Hallo Jürgen
ich hoffe sehr das dir der Lösungsvorschlag von Stefan hilft, sonst sehe ich ein echtes Problem auf dich zukommen!
Manche Tabellenblaetter enthalten Fehler wo ich nicht sagen kann was, warum, wieso sie entstanden sind, aber den Effekt von MS "Das Prgroamm wird geschlossen" ist mir allzugut bekannt. In einem anderen Thread habe ich drei Beispieldatein heruntergeladen wo das Programm beim Öffnen abstürzte, eine andere liess sich wegen DLL Error nicht mehr speichern!! Da wird man verrückt, weil die Dateien einen Fehler haben den man nicht kennt, und selbst nicht beheben kann!! Nur frage mich bitte nicht wie solche Fehler entstehen?? Ich weiss es wirklich nicht!!
Beim DLL Error konnte ich nicht mal den Makro Befehl Left() benutzen, weil die Bibliothek ihn einfach nicht kannte!! Fügte ich solche Befehle ein kam DLL Error und die Datei war Schrott, liess sich nicht mehr speichern!! Dann fluchst du wie ein Rohrspatz!! Vor allem, du verstehst überhaupt nicht was da falsch gelaufen ist!! Forum Praxis...
Abhilfe war:
Ich habe eine ganz neue Mappe eröffnet, unter gleichem Datei Name mit Endung " neu" gespeichert, und dann alle Tabllen 1:1 rüberkopiert. Inclusive UserForm, die ich in der neuen Mappe komplett neu nachgebaut habe. Dann hatte ich endlich Ruhe und alles war wieder normal!! Das ist leider leider viel Arbeit, aber im schlimmsten Fall die beste Möglichkeit sich Aerger vom Hals zu schaffen.
In deinem Fall: kopiere zuerst die verdaechtige Datei und dann versuche mal die Tabellenblaetter einzeln zu kopieren, indem du in die Loop Schleife vor dem Kopieren evtl. eine MsgBox reinsetzt, und schaust bei welchem Tabellenblatt der Fehler auftritt. Im schlimmsten Fall müsstest du diese Blaetter manuell neu erstellen. Die Arbeit wünsche ich dir sicher nicht, aber du hast uns ja um Rat und Hilfe gefragt ...
mfg Gast 123
Registriert seit: 17.01.2018
Version(en): 2016
Erst einmal danke das ihr euch Zeit nimmt mir bei meinen Problem zu helfen.
Habe auch erst einmal Ordnung in meinen Code gebracht aber dies hat leider nicht geholfen. Habe jetzt mal eine neue Excel Datei gemacht und den Code 1zu1 neu eingetippt. Dann habe ich mir zufällige drei Dateien rausgesucht und diese in einen Ordner gepackt. Habe dann 10 mal das Makro drüber laufen lassen. In 6/10 fällen hat es geklappt in 4 ist Excel leider wieder abgestürzt obwohl die Dateien sich nicht verändert haben. Die Dateien einzeln zu öffnen und in einer neuer per Hand zu kopieren geht leider nicht, deswegen hab ich das Makro geschrieben. Sollte es wirklich nicht funktionieren, gibt es dann eine andere Möglichkeit das was umgesetzt werden soll, umzusetzen?
mit freundlichen Gruß
Registriert seit: 12.03.2016
Version(en): Excel 2003/ 2016
Hallo Jürgen
wenn der Code automatisch ablaufen muss vielleicht hift dir der On Error Resume Next Befehl, wenn man dahinter eine MsgBox zum anzeigen setzt. Dann weisst du wenigstens was -Nicht kopiert- wurde! Hift dir das weiter???
mfg Gast 123
Code:
On Error Resume Next
strDatnam = Dir(CStr(spfad & "*.xls"))
Do While Len(strDatnam)
Set wb = Workbooks.Open(spfad & strDatnam)
Set ws = ThisWorkbook.Sheets.Add
ws.Name = AnzahlTabellen
AnzahlTabellen = AnzahlTabellen + 1
wb.Sheets(1).Cells.Copy Destination:=ws.Cells
wb.Close savechanges:=False
'Fehlermeldung was nicht kopiert wurde
If Err > 0 Then
MsgBox wb.Name & " " & wb.Sheets(1).Name & " - Nicht kopiert"
Err = 0
End If
Set ws = Nothing
Set wb = Nothing
strDatnam = Dir
Loop
Registriert seit: 17.01.2018
Version(en): 2016
17.01.2018, 15:17
(Dieser Beitrag wurde zuletzt bearbeitet: 17.01.2018, 15:17 von Excel_Jürgen.)
Ich habe dein Befehl mal eingefügt, doch er zeigt mir kein Error an, da Excel einfach abstürzt, oder habe ich was falsch verstanden?
mit freundlichen Gruß
Registriert seit: 12.03.2016
Version(en): Excel 2003/ 2016
Hallo Jürgen
nein, leider nicht, dann ist der Chrash soo gewaltig das er selbst mit On Error -Nicht abgefangen- werden kann!! Offen gesagt "great Mist ..."
What nu??? Da habe ich im Augenblick auch keine Idee mehr ... Vielleicht weiss ein Kollege da noch Rat??
mfg Gast 123
Registriert seit: 11.04.2014
Version(en): '97 bis 2016; 365
Hallo Jürgen,
suche mal bei Google unter "korrupte Exceldatei".
Ich kenne zwar ein Excel-Zusatzprogramm, welches bei korrupten Dateien eigentlich saugut helfen kann,
aber das greift für Excel-Dateien ab Excel 2007 nicht mehr. Vielleicht wirst Du ja bei Google fündig.
Registriert seit: 17.01.2018
Version(en): 2016
18.01.2018, 09:56
(Dieser Beitrag wurde zuletzt bearbeitet: 18.01.2018, 09:56 von Excel_Jürgen.)
Hallo Excel Freunde
ich habe 5 neue Excel Datei erstellt den Inhalt 5 zufälliger Dateien (Tabelle von A1-H100 + strg C) per Hand in die Excel Tabelle eingefügt. Auch mit den neuen Dateien kommt der Fehler. Vielleicht kommt er mit der Formatierung / Firmenlogo nicht klar, oder der code ist einfach zu Fehler anfällig. Gibt es noch eine andere Möglichkeit hast er die 5 Dateien öffnet, den Inhalt kopiert und in einer Neuen Datei mit mehreren Sheets einfügt? Also das was der Code machen sollte vielleicht umgeschrieben?
Edit: Ich habe eine Teillösung gefunden, wenn ich den Inhalt der Dateien kopiere und bei der Einfügeoption (nur werte) nehme, scheint es zu funktionieren. Wie kann ich mein Code so umschreiben, dass er nicht die ganze Datei kopiert, sondern alles kopiert und in die neue Datei nur die Werte einfügt?
Mit freundlichen Gruß
00202
Nicht registrierter Gast
Hallo, :19:
probiere mal nach der Codezeile mit dem
kopieren/einfügen folgende Codezeile:
Code:
Application.CutCopyMode = False
Oder lasse mal das "
Set ws = ThisWorkbook.Sheets.Add" weg und kopiere statt "
wb.Sheets(1).Cells.Copy Destination:=ws.Cells" gleich das ganze
Tabellenblatt.
Folgende(r) 1 Nutzer sagt Danke an Gast für diesen Beitrag:1 Nutzer sagt Danke an Gast für diesen Beitrag 28
• Gast 123