Gleichen Bereich aus 100 Dateien auslesen

Forumthread: Gleichen Bereich aus 100 Dateien auslesen

14.03.2005 18:48:53

R.Schmitt

Einen schönen Abend allerseits,
heute schlage ich mich mit 100 .xls Dateien unter-
schiedlicher Bezeichung herum, die im gleichen Ver-
zeichnis liegen und auch vom Aufbau her identisch
sind.
Aus diesen müßte ich jeweils den Bereich B9:H189
aus dem Arbeitsblatt "Liste" heraus in eine neue
Datei jeweils untereinander kopieren. Damit ergibt
sich also eine Gesamtliste von 100 x 180 = 1800
Zeilen.
Wer möchte mir denn helfen, diese Arbeit nicht
händisch sondern von Excel erledigen zu lassen ?
Schon mal vielen Dank
R.Schmitt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Gleichen Bereich aus 100 Dateien auslesen

14.03.2005 19:34:16

Ramses

Hallo
bei VBA-Gut kannst du das ja sicher leicht anpassen


Sub Dateien_in_eine_Tabelle_zusammenfuehren()
'by Ramses
Dim myFSO As Object
Dim myFld As Object
Dim Exfiles As Object
Dim xlFile As Object
Dim wbMainBook As Workbook
Dim wbDataBook As Workbook
Dim iCounter As Integer
'Kann aktiviert werden
'Application.DisplayAlerts = False
'Sollte aktiviert werden wegen Bildschirmflackern
'Application.ScreenUpdating = False
'Erstellt neue Mappe für die Datenausgabe
Set wbMainBook = Workbooks.Add
'Zeilenzähler initialisieren
iCounter = 1
Set myFSO = CreateObject("Scripting.FileSystemObject")
Set myFld = myFSO.getfolder("D:\DeinFolder")
Set Exfiles = myFld.Files
For Each xlFile In Exfiles
'Prüfen auf Dateinamen wenn
'auch noch andere Dateien im Ordner sind
If LCase(Right(xlFile.name, 3)) = "xls" Then
'Zuweisen der Variablen
Set wbDataBook = Workbooks.Open(xlFile.path, UpdateLinks:=3)
'Kopieren einer Zelle
wbDataBook.Worksheets("DeineTabelle").Range("C21").Copy _
Destination:=wbMainBook.Worksheets(1).Cells(iCounter, 1)
'Kopieren eines Bereiches
wbDataBook.Worksheets("Kopfdaten").Range("F19:F20").Copy _
Destination:=wbMainBook.Worksheets(1).Cells(iCounter, 2)
'Zeilenzähler hochsetzen
iCounter = iCounter + 1
'Geöffnete Mappe schliessen
wbDataBook.Close
'Variable leeren
Set wbDataBook = Nothing
End If
Next
'Speichert die Zusammengefasste Tabelle
wbMainBook.SaveAs "d:\Deinfolder\All_Data.xls"
'Variable leeren
Set wbMainBook = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Gruss Rainer

schleife in application.filesearch.FoundFiles

14.03.2005 19:34:56

ransi

hallo r.schmitt
wenn dein angegebenes VBA level stimmt, dann versuch ich mal einen weg zu skizzieren:
-mit application.filesearch alle .xls in dem verzeichniss suchen
--for i = 1 to application.filesearch.foundfiles.count
---workbooks.open(application.filesearch.foundfiles(i))
-den bereich kopieren
-in die zieldatei in die erste freie zelle in B einfügen
-datei schliessen
-next i
ransi

Beliebteste Forumthreads (12 Monate)

Gleichen Bereich aus 100 Dateien auslesen

Forumthread: Gleichen Bereich aus 100 Dateien auslesen

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Gleichen Bereich aus 100 Dateien auslesen

Forumthread: Gleichen Bereich aus 100 Dateien auslesen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread