Gleichartige Excel-Dateien auswerten

Hallo zusammen,
habe viele Exceldateien in einem Verzeichnis, die alle identisch aufgebaut sind (dienen als Formular). Deren Dateinamen kann ich bereits in ein neues Sheet schreiben und dann ueber eine Schleife der Reihenfolge nach aktivieren/oeffnen. Die Dateien beinhalten jeweils nur ein Arbeitsblatt/Sheet und heissen immer gleich.
Sieht ungefaehr so aus momentan:
Path ; Filename
D:\tmp\tryout\ ; 2006_03_14_test1.xls
D:\tmp\tryout\ ; 2006_03_15_test2.xls
D:\tmp\tryout\ ; some_weird_filename.xls
Allerdings weiss ich jetzt nicht, wie ich am besten vorgehen soll:
Ich moechte einige der Felder aus den Ausgangsformular auswerten. Diese Felder befinden immer an der gleichen Position. Den Inhalt der Felder moechte ich in eine neue Tabelle schreiben. Diese Tabelle dient dann statistischen Zwecken (das bekomme ich wiederrum dann hin).
Sollte ich alle Dateien erst in eine Datei zusammenkopieren, oder sollte ich das nach und nach machen? Evtl werden ca 50-200 Files abgearbeitet werden muessen.
Ein kleines Beispiel waere fuer mich VBA-Anfaenger auch ganz nett :)
Vielen Dank im Vorraus
Gruesse
Clemens

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Clemens,
folgender Code öffnet die Dateien eines Verzeichnisses und schreibt die Daten der angegeben Zellen in eine neue Arbeitsmappe.


Sub DatenEinlesen()
' Daten aus mehreren Dateien in eine neue Datei einlesen
Dim wkbNeu As Workbook, wksDataSheet As Worksheet, Pfad As String
Dim Datei As Variant, I As Integer, J As Integer, Zellen As Variant, Titel As Variant
Pfad = "C:\Test" ' Pfad der Daten-Dateien anpassen
'Spaltentitel anpassen bzw. ergänzen
Titel = Array("Spaltentitel 1", "Spaltentitel 2", "Spaltentitel 3", "Spaltentitel 4")
'Zellen die ausgelesen werden sollen. Liste anpassen bzw. ergänzen
'Zellen in der Reihenfolge der Spaltentitel angeben
Zellen = Array("B3", "D3", "F7", "C10")
' Neue Arbeitsmappe öffen , alternativ hier eine leere Musterdatei öffnen
Workbooks.Add Template:="Arbeitsmappe"
Set wkbNeu = ActiveWorkbook
' Daten-Dateien suchen
Datei = Dir(Pfad & "\Test*.XLS") ' Suchstring für EXCEL-Dateien anpasssen
' Spaltentitel setzen, kann bei Musterdatei entfallen
For J = 0 To UBound(Titel)
wkbNeu.Sheets(1).Cells(1, J + 1) = Titel(J)
Next J
I = 2 'Startzeile für Daten in neuer Datei
Do Until Datei = ""
' Daten-Datei öffnen
Application.ScreenUpdating = False
Workbooks.Open Pfad & "\" & Datei
Set wksDataSheet = ActiveWorkbook.Sheets(1)
' Daten in neue Datei übertragen
For J = 0 To UBound(Zellen)
wkbNeu.Sheets(1).Cells(I, J + 1) = wksDataSheet.Range(Zellen(J))
Next J
' Daten-Datei wieder schließen
ActiveWorkbook.Close False
Datei = Dir
I = I + 1
Application.ScreenUpdating = True
Loop
wkbNeu.Activate
' Neue Arbeitsmappe speichern
Application.Dialogs(xlDialogSaveAs).Show
End Sub

Gruß
Franz

Beliebteste Forumthreads (12 Monate)

Gleichartige Excel-Dateien auswerten

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread