Office: Daten aus mehreren gleichen Dateien untereinander anfügen

Hallo Leute,

ich habe ca 40 Dateien. Diese haben alle den gleichen Aufbau (Spalte A bis bb) sind aber unterschiedlich lang. Diese dateien liegen csv-Format vor. Die Dateien liegen alle im gleichen verzeichnis. Die Dateien haben alle nur 1 Tabellenblatt, welches unterschiedliche Namen hat.
Nun möchte ich aus den 40 einzelnen Dateien eine Gesamtdatei erstellen ohne jede einzeln öffnen und die Daten per copy and paste rüberzuholen bzw. unten anzufügen.

Gibt es dafür die Möglichkeit dies per Funktion oder VBA zu lösen?

Bin für jede Hilfe oder Anregung dankbar. Sollten euch Informationen fehlen, fragt einfach nach.

Vielen Dank
Gruß

 

Hi,

wenn dies nur eine einmalige Sache ist, wieso etwas Programmieren?

Ich meine im Code (so weit ich mich da auskenne!) muß man jede einzelne Datei aufrufen, sprich Verzeichnis, Name der Datei, Name der Tabelle...

Mein Vorschlag für dich falls es einmalig ist lieber selbst alles in eine Datei kopieren/verschieben.

Ansonsten kann ich dir mal den Code geben:
(denk das es so funktionieren müsste)

Code:

Sub KopierenArbeitsblatt()
Dim Mappe As Workbook
Dim Blatt As Worksheet

Set Blatt = ActiveSheet
Application.ScreenUpdating = False
'Damit man den ganzen Ablauf nicht immer anschauen muß
On Error Resume Next
Set Mappe = Workbooks.Open ("C:\Verzeichnis\...\Dateiname.xyz")
 Blatt.Copy Before:=Mappe.Sheets(1)
 Mappe.Save
 Mappe.Close
Application.ScreenUpdating = True
End Sub

Etwas anderes find ich nicht, aber soweit ich es sehe Kopiert er hier das offene Blatt und fügt es in der genannten Datei ein, speichert es und schließt es.

Hatte dazu keine Gelegenheit es auszuprobieren.

Gruß Emi

 

Hi,

geht es darum, die Tabellenblätter jeweils als extra Blatt in die neue Mappe zu kopieren, sodass die Mappe dann 40 Tabellenblätter beinhaltet oder alle Daten in ein gemeinsames Tabellenblatt zu übernehmen? Für letzteres kannst du es mit folgendem Code versuchen:

Code:

Sub MehrereArbeitsmappenUebernehmen()
    Dim strVerzeichnis As String
    Dim strTyp As String
    Dim strDateiname As String
    Dim loZeile As Long
    Dim loLetzte As Long
    strTyp = "*.csv"
    Application.ScreenUpdating = False
    strVerzeichnis = "C:\Test\"  '<== Pfad anpassen
    strDateiname = Dir(strVerzeichnis & strTyp)
    loZeile = 1
    Do While strDateiname <> ""
        Workbooks.Open Filename:=strVerzeichnis & strDateiname
        With ActiveWorkbook.Worksheets(1)
            loLetzte = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
            .Range(.Cells(1, 1), .Cells(loLetzte, 54)).Copy ThisWorkbook.Worksheets("Tabelle1").Cells(loZeile, 1)
        End With
        ActiveWorkbook.Close True
        strDateiname = Dir
        loZeile = loZeile + loLetzte
    Loop
    ActiveSheet.Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True
    Application.ScreenUpdating = True
End Sub

Bis später,
Karin