Anzeige
Archiv - Navigation
1832to1836
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro_Blatt-aus-anderer-Datei-Import

Makro_Blatt-aus-anderer-Datei-Import
10.06.2021 20:21:04
Hendrik
Hi zusammen!
Ich habe eine Vielzahl an Excel-Dateien, die alle gleich aufgebaut sind.
Eine Datei enthält dabei eine Anzahl an Bereichs-Tabellenblättern und ein Gesamtblatt, wo alle Bereiche einfließen.
Gerade baue ich eine neue Excel-Datei, die nun alle o.g. Gesamtblätter einsammelt.
Dazu habe ich folgenden Code gefunden und etwas angepasst, der soweit grob funktioniert:
'Hinweise: Die Zieldatei darf nicht im gleichen Verzeichnis sein, wie die einzulesenden Dateien.
'Das Beispielmakro importiert immer das erste Arbeitsblatt von allen Dateien, die im
'angegebenen Verzeichnis enthalten sind. Diese Arbeitsblätter werden in die Arbeitsmappe eingefügt,
'in der sich das folgende Makro befindet und gestartet wird.
'Die einzulesenden Dateien müssen geschlossen sein.

Sub MWSheetsAusMehrerenDateienEinlesen()
Dim oTargetBook As Object
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Application.ScreenUpdating = False 'Das "Flackern" ausstellen
Application.DisplayAlerts = False 'Keine Fehlermeldungen anzeigen
'Schritt 1: Arbeitsmappe festlegen, in die die neuen Sheets eingefügt werden...
Set oTargetBook = ActiveWorkbook
'Wichtiger Hinweis: Die Arbeitsblätter dürfen nicht vorhanden sein!
'Alternativer Umbau: Löschen evtl. bereits vorhandener Arbeitsblätter
'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
sPfad = "C:\MeinPfad\Test\"
sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
Do While sDatei  ""
'Schritt 3: öffnen der Datei und Datenübertragung
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
Application.Run sDatei & "!Einblenden-aller-Blätter" 'dies muss ich ausführen, weil in den Dateien alle Blätter bis auf das Deckblatt ausgeblendet sind.
'Sage ihm hier also, bitte alle einzublenden, damit ich das gewünschte Gesamtblatt  importieren
'kann
'Es wird immer das erste Tabellenblatt Sheets(1) kopiert!
Worksheets("Gesamtblatt").Move _
before:=Worksheets("Deckblatt")                                            'hier sage ich ihm, das Gesamtblatt bitte an erste Stelle zu schieben, weil das Makro immer nur die erste
'Tabelle importiert
oSourceBook.Sheets(1).Copy after:=oTargetBook.Sheets(oTargetBook.Sheets.Count)
'Es wird versucht den Dateinamen als Arbeitsblattnamen zu setzen.
'Ist dieser bereits vorhanden wird der Fehler abgefangen und das neue Blatt
'bekommt keinen anderen Namen und behält den typischen Namen Tabelle x
On Error Resume Next
'Arbeitsblattname wird der Dateiname
oTargetBook.Sheets(oTargetBook.Sheets.Count).Name = sDatei
'Wenn ein Fehler aufgetreten ist, wird dieser resettet
If Err.Number  0 Then
Err.Number = 0
Err.Clear
End If
On Error GoTo 0
'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
oSourceBook.Close False 'nicht speichern
'Nächste Datei
sDatei = Dir()
Loop
Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
Application.DisplayAlerts = True 'Fehlermeldungen wieder anzeigen
'Kleine finale Fertig-Meldung
MsgBox "Fertig!", vbInformation + vbOKOnly, "Hinweis!"
'Variablen aufräumen
Set oTargetBook = Nothing
Set oSourceBook = Nothing
End Sub
Probleme, die auftreten:
1) Wenn er das Gesamtblatt in die neue Datei kopiert, werden leider auch die Makros, die in dem Tabellenblatt (nicht in einem Modul) liegen, mitkopiert. Dadurch gibt er dann eine Fehlermeldung, wenn er in der neuen Datei diese Makros ausführen möchte.
2) Leider, da das ganze Blatt kopiert wird, werden auch die Formeln mitkopiert, was mir für Folgeschritte Probleme bereitet.
Frage: Lassen sich 1) und 2) eventuell auf einen Schlag beheben, indem man den Code anpasst, dass das Tabellenblatt, aber nur die Werte und ohne die Makros, kopiert werden? Und wenn ja: Könnt ihr mir da helfen? Ich habe die Codezeile, von der ich vermute, die man anpassen müsste, fett und kursiv markiert.
Besten Gruß!
Hendrik

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
ja, mit Power Query
10.06.2021 23:16:17
Yal
Hallo Hendrik,
wenn Du noch nicht mit Power Query gearbeitet hast, schaue Dir diesen Turorial. 7te Video rauslassen, dann nur noch 40 -gut investierte- Minuten, noch weniger, wenn Du die Abspiel-Geschwindigkeit erhöhst (es ist Turorial-Geschwindigkeit)
Excel Hero Power Query Playlist
https://www.youtube.com/playlist?list=PLy5TtUB84yrN2VVRzp8Tif8bxQKJD_2bo
Tipp zur Fehler-Behandlung: wenn Du eine Fehler-Toleranz (On Error Resume Next) nur auf eine Anweiseung haben möchte, verlagere diese Anweisung in einem separaten Sub/Function. Die On Error hat nur innerhalb die Sub/Function und Du musst nicht der Err resetten.
VG
Yal
Anzeige
AW: ja, mit Power Query
11.06.2021 11:11:31
Hendrik
Hi Yal,
cool, das kannte ich wirklich noch nicht! Danke dir, das ziehe ich mir am WE rein.
Denkst du, dass trotzdem eine Anpassung an dem Code möglich ist? Mein Professor hätte das gerne so...
Ich hoffe ja, dass nur eine Justierung an dieser Stelle nötig ist:
oSourceBook.Sheets(1).Copy after:=oTargetBook.Sheets(oTargetBook.Sheets.Count)
Besten Gruß!
Hendrik

306 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige