never-ending Sanduhr ...

... = rotierender blauer Kreis. Hi Team, die beilieg. zip, mit den stark vereinfachten/reduzierten (!) Dateien tut genau das, was sie soll. Sie holt alle Arbeitsblätter aus "die 1.xlsx" und "die 2.xlsm", kopiert alles in die geöffnete "Mappe1.xlsm" und löscht dann am Ende "Tabelle1". Arbeite ich jedoch wie vor statt (1) und (2) mit den "wahren", deutlich komplexeren Daten, kommt bald "der blaue Kreis" und mag nicht wieder enden, keine Rückmeldung, auch kein Datenverlust ! Kann ich irgendwie feststellen, wo, wann warum die Excel-VBA "hakt" ? Das Netz liefert hier nichts konkretes, leider nur "Trial and Error Lösungen" und bietet mühsames Probieren an.
Hier mein funktionierendes Schema : https://www.herber.de/bbs/user/157577.zip. Wähle ich jedoch etwas umfangreicheres, "knackt" es schon bei irgendeinem Blatt ...
THX Klaus Reich

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
ich habe das Programm bei mir mal gecheckt. Da laeuft es problemlos, ohne Endlos Schleife!
Allerdings habe ich den Code aus der Tabelle1 herausgenommen, und in ein normales Modul kopiert!!
Zusatzlich habe ich noch eine Fehlermeldung eingebaut. Teste den Code bitte mal in einem Modul.
mfg Piet

Private Sub CommandButton1_Click()
Call AlleTabellenblätterZusammenführen
End Sub

Sub AlleTabellenblätterZusammenführen()
Dim vntPfadUndDateiNamen As Variant
Dim strPfadUndDatei As String
Dim lngi As Long
Dim wbkMappe As Workbook
Dim wksTabelle As Worksheet
Dim wbkZiel As Workbook
Set wbkZiel = ThisWorkbook
' ursprünglich :
' mit Shift und rechte Maus alles markieren
' vntPfadUndDateiNamen = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Wählen Sie die Dateien für die Zusammenführung aus!", MultiSelect:=True)
' nun aber NUR alle *.xlsx und *.xlsm :
On Error GoTo Fehler
vntPfadUndDateiNamen = Application.GetOpenFilename(FileFilter:="Excel Files(*.xls*),*.xls*", Title:="Wählen Sie die Dateien für die Zusammenführung aus!", MultiSelect:=True)
If VarType(vntPfadUndDateiNamen) = vbBoolean Then
MsgBox "Vorgang wurde abgebrochen!": Exit Sub
Else
For lngi = LBound(vntPfadUndDateiNamen) To UBound(vntPfadUndDateiNamen)
strPfadUndDatei = vntPfadUndDateiNamen(lngi)
' ich hole gerade, in meinem Fall, aus C:\Users\Willi\Desktop\mappe test
' MsgBox (strPfadUndDatei)
Set wbkMappe = Application.Workbooks.Open(strPfadUndDatei)
For Each wksTabelle In wbkMappe.Worksheets
wksTabelle.Copy wbkZiel.Worksheets(wbkZiel.Worksheets.Count)
Next
wbkMappe.Close False
Next
' den Dummy = Leereintrag namens Tabelle1 in Mappe1.xlsm löschen
' alternativ : statt "Mappe1" mit "Tabelle1" eine Mappe ohne (!) "Tabelle1" erzeugen ?
' zumindest : wenn wirklich alles ohne Fehlermeldung, crash, ... ewig laufender Eieruhr
' wie kann ich (nach x min. ?) alles autom. abbrechen ? nur, wenn's "gut" gegangen ist
' und nur dann - das auch ohne die Rückfrage - "soll ich dies auch wirklich löschen ?" tun
Worksheets("Tabelle1").Delete
End If
Exit Sub
Fehler: MsgBox "Fehler beim Zusammenführen: " & vbLf & Error()
End Sub

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

never-ending Sanduhr ...

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread