Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1792to1796
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

Tabblätter aus mehreren Dateien kopieren

Tabblätter aus mehreren Dateien kopieren
13.11.2020 14:46:53
Eugen
Hallo zusammen,
ich versuche für die Arbeit ein Makro zu basteln. Leider stoße ich an die Grenzen meines bescheidenen Wissens.
Folgendes Anliegen:
Ich bekomme mehrere (ca. 12) Dateien mit exakt demselben Aufbau von unterschiedlichen Abteilungen zugesandt.
Hieraus muss ich für die weitere Bearbeitung eine Datei machen. Also einfach alle Inhalte stumpf untereinander kopieren.
Aufbau Inputdateien:
-Jede Inputdatei hat nur ein Tabellenblatt
-Format unterschiedlich: teilweise csv, teilweise xlsx
-Die Überschriften stehen immer in der Zeile 1
-Die Daten selbst beginnen immer ab Zeile 2
-Das Tabellenblatt 1 hat immer eine unterschiedliche Menge an Daten (Zeilenanzahl variiert also)
Anforderung Outputdatei:
-neue Excelmappe wird im selben Ordner erstellt und gespeichert
-ganz oben die immer gleiche Überschriftenzeile, zwischendurch sollen die Überschriften nicht mehr auftauchen
-speichern als csv in UTF-8
-Name mit Datum versehen (Beispiel: Alle_Daten_20201113.csv)
Alle Inputdateien liegen in einem Ordner (nennen wir ihn C:\Inputordner)
In dem Ordner sind NUR die Inputdateien, keine anderen, die man ausklammern müsste.
Kann mir jemand einen Tipp geben? Ich wäre um jede Hilfe dankbar :)
Schönen Freitagnachmittag euch

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabblätter aus mehreren Dateien kopieren
13.11.2020 15:09:48
MCO
Hallo Eugen!
Probier das mal:
Das mit csv Format abspeichern hab ich jetzt nicht getestet, musst du mal aufzeichnen als Makro und dann reinkopieren...

Sub Dateisuche()
Dim Fso As Object
Dim SearchFolder As Object
Dim FD As Object, FI As Object
Dim EachFil As Object
Set new_wb = Application.Workbooks.Add
Set Fso = CreateObject("Scripting.Filesystemobject")
Set SearchFolder = Fso.GetFolder("C:\Inputordner")
Set EachFil = SearchFolder.Files            ' Dateien in der jeweiligen Root
'   Dateien auslesen
For Each FI In EachFil                      ' Schleife über alle Dateien
Workbooks.Open FI
ActiveWorkbook.Sheets(1).Range("A1").CurrentRegion.Copy new_wb.Sheets(1).Range("A" &  _
Rows.Count).End(xlUp)
Workbooks(FI.Name).Close 0
Next FI
new_wb.SaveAs "Alle_Daten_" & Date & "csv"
Set EachFil = Nothing
Set Fso = Nothing
End Sub
Gruß, MCO
Anzeige
AW: Tabblätter aus mehreren Dateien kopieren
13.11.2020 15:40:02
Eugen
Hallo MCO,
erst einmal vielen lieben Dank für deine schnelle Hilfe. Das weiß ich wirklich sehr zu schätzen.
Nur eine kleine Bitte. Da bin ich vielleicht nicht so gut drauf eingegangen. Ich brauche die Daten tatsächlich alle untereinander, nicht in verschiedenen Blättern. Also, dass alle Daten eine lange Liste auf einem Tabellenblatt ergeben und einmal die Überschriftenzeile in Zeile 1.
Ist das auch umsetzbar? :)
Vielen Dank
AW: Tabblätter aus mehreren Dateien kopieren
13.11.2020 17:32:48
Yal
Hallo zusammen,
das Speichern als csv führt dazu, dass nur das aktive Blatt von new_wb gespeichert wird.
Wenn die Dateien, die zusammenzuführen sind, dieselbe Struktur haben (und auch noch die Spaltentitel im erste Zeile haben), erklärt ExcelHero ganz genau, wie es mit Power Query geht: https://www.youtube.com/watch?v=NY3m_nLGuTg
Sieben gut investierten Minuten (kann man auch in Gesch. 1,5 laufen lassen)
Bin inwzischen Fan von Power Query, weil kein VB-Code notwendig ist (ja, kann man noch hinzufügen).
Viel Erfolg
Yal
Anzeige
AW: Tabblätter aus mehreren Dateien kopieren
16.11.2020 13:49:26
Eugen
Hallo Yal,
vielen Dank für den interessanten Hinweis, das werde ich mir näher ansehen.
Viele Grüße
Eugen
AW: Tabblätter aus mehreren Dateien kopieren
16.11.2020 11:05:17
MCO
Hallo Eugen!
Ich hab das Makro nochmal angepasst:
Import auf 1 Blatt, Kopfzeilen bei nachfolgenden Blättern entfernt
Nur Werte werden importiert, keine Formate
Kopie wird gespeichert unter csv, mit Datum nach Vorgabe.
Gruß, Marc
Sub Dateisuche()
Dim Fso As Object
Dim SearchFolder As Object
Dim FD As Object, FI As Object
Dim EachFil As Object
Set wb = ThisWorkbook
Set new_sh = wb.Sheets.Add
Set Fso = CreateObject("Scripting.Filesystemobject")
'Set SearchFolder = Fso.GetFolder("C:\temp")
Set SearchFolder = Fso.GetFolder("C:\Inputordner")
Set EachFil = SearchFolder.Files            ' Dateien in der jeweiligen Root
Z = 0
For Each FI In EachFil                      ' Schleife über alle Dateien
lz = new_sh.Range("A" & Rows.Count).End(xlUp).Offset(IIf(Z = 0, 0, 1)).Row
Workbooks.Open FI
ActiveWorkbook.Sheets(1).Range("A1").CurrentRegion.Copy
new_sh.Range("A" & lz).PasteSpecial (xlValues)
If Z > 0 Then new_sh.Rows(lz).EntireRow.Delete
Workbooks(FI.Name).Close 0
Z = Z + 1
Next FI
wb.SaveCopyAs "Alle_Daten_" & Format(Date, "YYYYMMDD") & ".csv"
Set EachFil = Nothing
Set Fso = Nothing
End Sub

Anzeige
AW: Tabblätter aus mehreren Dateien kopieren
16.11.2020 13:50:43
Eugen
Hallo Marc,
vielen lieben Dank, es funktioniert wunderbar. Vielen Dank für deine Mühe und einen schönen Start in die Woche
Viele Grüße
Eugen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige