Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
584to588
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
584to588
584to588
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Gleichen Bereich aus 100 Dateien auslesen

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

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
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)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige