==> an IngGI / Info. aus geschl. Dateien
27.06.2005 16:59:13
Ingo
habe folgendes Makro jetzt mal eingepflegt und das Verzeichnis geändert.
Erstens:
Er bleibt in der Übersicht nach dem Ausführen auf der Ausgangsposition stehen und macht garnichts. Liegt es daran, daß ich bei "Range" die zu kopierende Zelle in Hochzeichen gestellt habe...?
Zweitens:
Um alle Dateien aus dem Ordner zu erwischen muß ich doch nach dem \06-2005\ ein (") setzen, oder...?
Vielen Dank für Hilfe...
Gruß, Ingo
---------------------------------
Sub Uebersicht()
Dim fso As Object, fo As Object, f As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set fo = fso.GetFolder("\\eyfps\home\Projektplanung\Projekte\Angebote\06-2005\")
On Error GoTo Fehler
Application.ScreenUpdating = False
For Each f In fo.Files
Workbooks.Open (f.FullName)
'Übersicht nächste freie Zeile, Spalte A/Kd-Nr.
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0) = _
Workbooks(f.Name).Sheets(1).Range("B2")
'Übersicht nächste freie Zeile, Spalte B/Kd-Name
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(1, 1) = _
Workbooks(f.Name).Sheets(1).Range("B3")
'Übersicht nächste freie Zeile, Spalte C/Kd-Ort
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(1, 2) = _
Workbooks(f.Name).Sheets(1).Range("B4")
'usw. für die restlichen Daten
Workbooks(f.Name).Close False
Next f
Fehler:
Application.ScreenUpdating = True
End Sub