Mehrere Mappen zu einer Mappe zusammenführen

Question

Einen schönen Abend ans Forum!
Ich möchte mehrere Mappen, die jeweils nur ein Tabellenblatt enthalten und alle gleich aufgebaut sind, zu einer einzigen Mappe zusammenführen. Die Mappen sind abgespeichert unter A_1, A_2,...A_100.
Alle Mappen enthalten, wie erwähnt ein Arbeitsblatt, das jeweils mit "Datenblätter" benannt worden ist.
Ideal wäre, wenn überhaupt möglich, dass in der neuen Mappe mit den Zusammenführungen die Tabellenblätter jeweils mit dem Mappennamen "A_1, A_2,...A_100" versehen werden.
Ich habe aber keine Ahnung und habe auch im web zu diesem Thema nichts gefunden, ob mein Anliegen überhaupt machbar ist.
Wenn nein, dann mach ich das manuell. Wenn ja, dann wäre ich um jede Hilfe dankbar.
Danke und noch einen schönen Abend von Robert

Answer 1

Hallo Robert,

kopiere das folgende Makro in ein allgemeines Modul einer leeren Arbeitsmappe. Ich gehe mal davon aus, dass die einzelnen Mappen alle in einem Verzeichnis gespeichert sind. Das Makro kopiert die einzelnen Blätter in die Mappe, in der das Makro gespeichert ist:

Sub Mappen_zusammen()
Dim z As Long
Dim strPfad As String
Dim strName As String

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Pfad festlegen, in dem die Arbeitsmappen gespeichert sind - anpassen
strPfad = "C:\Test\"

For i = 1 To 100                             'Zähler für Arbeitsmappen
  strName = strPfad & "A_" & i & ".xlsx"    'Name der zu öffnenden Mappe generieren
   If Dir(strName) <> "" Then                'Falls Datei vorhanden, dann
     Workbooks.Open Filename:=strName          'Arbeitsmappe öffnen
     With ActiveWorkbook
       .Worksheets("Datenblätter").Name = "A_" & i       'Datenblätter umbenennen in Name der Arbeitsmappe
       .Worksheets("A_" & i).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Worksheets.Count)    'Blatt in diese Mappe kopieren
       .Close (False)                      'geöffnete Arbeitsmappe schließen, ohne die Änderungen zu speichern
     End With
   End If
Next i

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Gruß

M.O.

Answer 2

Hallo M.O.
Recht herzlichen Dank für deine Lösung. Ich bin erst heute dazugekommen, diese auszuprobieren.
Ich habe den Code entsprechend deinen Anweisungen eingegeben, den Pfad der abgespeicherten Mappen eingetragen. Leider bin ich damit nicht erfolgreich. Excel reagiert nicht, manchmal erscheint `Laufzeitfehler 9´.

Auch die Variante mit dem Umbenennen von A_1 in A_01 war nicht erfolgreich, nachdem ich festgestellt habe, dass nach dem Schließen des Blattes das Blatt "A_10" geöffnet war und nicht das Blatt A_01. So als hätte es nicht weitergezählt.

Vielleicht liegt das Problem auch darin, dass die Inhalte der zu kopierenden Mappen mit meiner Datenbank - das ist auch eine Excel-Datei - verknüpft sind und bei manchen Versuchen das Pop-up „aktualisieren“ erscheint.
Robert

Answer 3

Hallo Robert,

bin erst heute dazu gekommen, dir zu antworten.

Der Laufzeitfehler 9 deutet darauf hin, dass Blätter nicht gefunden wurden. Dies kann z.B. passieren, wenn die Namen der einzelnen Datenblätter falsch geschrieben sind.

Die Nachfragen kann man unterdrücken.

Da die zu öffnenden Mappen ja nur ein Datenblatt haben, kannst du mal die folgende Version probieren:

Sub Mappen_zusammen()
Dim z As Long
Dim strPfad As String
Dim strName As String

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Nachfragen unterdrücken
Application.DisplayAlerts = False

'Pfad festlegen, in dem die Arbeitsmappen gespeichert sind - anpassen
strPfad = "C:\Test\"

For i = 1 To 3                              'Zähler für Arbeitsmappen
  strName = strPfad & "A_" & i & ".xlsx"    'Name der zu öffnenden Mappe generieren
   If Dir(strName) <> "" Then                'Falls Datei vorhanden, dann
     Workbooks.Open Filename:=strName          'Arbeitsmappe öffnen
     With ActiveWorkbook
       .Worksheets(1).Name = "A_" & i       'Datenblätter umbenennen in Name der Arbeitsmappe
       .Worksheets("A_" & i).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Worksheets.Count)    'Blatt in diese Mappe kopieren
       .Close (False)                      'geöffnete Arbeitsmappe schließen, ohne die Änderungen zu speichern
     End With
   End If
Next i

'Nachfragen zulassen
Application.DisplayAlerts = True

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

In der Datei mit der Zusammenfassung wird immer das letzte Blatt geöffnet, das in die Mappe kopiert wurde.

Warum das Makro bei dir nicht reagiert, kann ich nicht sagen. Bei meinem Tests funktioniert es tadellos.

Wenn du die Namen von A_1 in A_01 änderst, musst du natürlich auch den Code entsprechend anpassen.

Gruß

M.O.

Answer 4

Hallo M.O.

Diesmal funktioniert dein Code einwandfrei.
Wie du schon erwähnt hast, muss ich zunächst die Blätter nicht mit A_01 sondern A_1 bezeichnen.
Was noch etwas stört, ist bei jedem Blatt die Nachfrage bezüglich der Aktualisierung der Daten (diese wurden aus meiner zentralen Datenbank abgerufen). Könnte man diese eventuell unterbinden?

Aber recht herzlichen Dank für dein Bemühen und ich nehme an, dass auch noch andere Forumsmitglieder von deinem Beitrag profitieren können.
Grüße von Robert

Answer 5

Hallo Robert,

um die Abfrage zur Aktualisierung zu unterdrücken, ändere den Workbooks.Open-Befehl wie folgt:

 Workbooks.Open Filename:=strName, UpdateLinks:=True          'Arbeitsmappe öffnen und Links aktualisieren

Gruß

M.O.

Answer 6

Hallo M.O.!

Nun funktioniert dein Code perfekt, nachdem die Abfrage zur Aktualisierung ausgeschalten wurde.

Nochmals recht herzlichen Dank von meiner Seite.

Robert