Herbers Excel-Forum - das Archiv
Tabellenbereiche einlesen
- Tabellenbereiche einlesen von Dieter van Bocksen vom 29.12.2006 10:11:01
- AW: Tabellenbereiche einlesen - von haw am 29.12.2006 11:40:16
 |
Betrifft: Tabellenbereiche einlesen
von: Dieter van Bocksen
Folgende Probleme stellen sich mir kurzfristig.
Beginnend mit einem leeren Excel-Arbeitsblatt soll aus allen sich in einem
Ordner befindlichen Excel-Dateien die Zeilen 4 bis 51 gelesen und per Anfügung
in das leere Excel-Blatt gelesen werden.
also:
1. Öffne Excel - Liste manuell und starte Makro.:- so soll es automatisiert laufen.
1. Ermittlung aller Excel-Dateien im Ordner
2. Lesen der ersten Excel-Datei , kopieren Zeilen 4 - 41
3. Füge in die neue Excel-Liste ein und gehe an Ende
4. Nehme die nächste Excel-Datei - weiter mit den Punkten 2-4
Hat dafür jemand eine Lösung ?
mfg. und einen guten Jahresstart
 |
Betrifft: AW: Tabellenbereiche einlesen
von: haw
Geschrieben am: 29.12.2006 11:40:16
Hallo Dieter,
hier einmal eine Möglichkeit (Unterordner werden nicht berücksichtigt):
Sub Einlesen()
Dim fs As FileSearch, wb As Workbook, ws As Worksheet, wsG As Worksheet
Dim efz%, Ordner$
Dim iCounter As Integer
Set wsG = ThisWorkbook.Worksheets(1)
Ordner = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
If Ordner = "" Then Exit Sub
Set fs = Application.FileSearch
With fs
.FileType = msoFileTypeExcelWorkbooks
.LookIn = Ordner
.Execute
For iCounter = 1 To .FoundFiles.Count
Cells(iCounter, 1).Value = .FoundFiles(iCounter)
Workbooks.Open Filename:=.FoundFiles(iCounter)
Set wb = ActiveWorkbook
Set ws = wb.Worksheets(1)
efz = wsG.Cells(Rows.Count, 1).End(xlUp).Row + 1
ws.Rows("4:51").Copy wsG.Cells(efz, 1)
wb.Close False
Next iCounter
End With
End SubGruß Heinz
| |