Excel Makros stürzt ab

[Excel_Jürgen]

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

[Steffl]

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

[Gast 123]

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

[Excel_Jürgen]

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ß

[Gast 123]

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

[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ß

[Gast 123]

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

[Käpt'n Blaubär]

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.

[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ß

[Case]

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.