Gleichen Bereich aus 100 Dateien auslesen

Bild

Betrifft: Gleichen Bereich aus 100 Dateien auslesen
von: R.Schmitt
Geschrieben am: 14.03.2005 18:48:53
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

Bild

Betrifft: AW: Gleichen Bereich aus 100 Dateien auslesen
von: Ramses
Geschrieben am: 14.03.2005 19:34:16
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
Bild

Betrifft: schleife in application.filesearch.FoundFiles
von: ransi
Geschrieben am: 14.03.2005 19:34:56
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
Bild

Betrifft: AW: Gleichen Bereich aus 100 Dateien auslesen
von: Nike
Geschrieben am: 15.03.2005 10:15:17
Hi,
check this:
https://www.herber.de/forum/index.htm?https://www.herber.de/forum/archiv/240to244/t240479.htm
Bye
Nike
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Gleichen Bereich aus 100 Dateien auslesen"