@IngGI - Hyperlink
29.06.2005 11:13:21
Ingo
...immer ruhig bleiben...! In der Ruhe liegt die Kraft...!
Habe Dir jetzt nochmal den gesamten Code eingestellt, den ich hier verwende. Leider ist das Probleme mit Deiner neuen Version noch nicht behoben. Kann es daran liegen, daß er die Daten aus den Angeboten aus den Sheet(2) holt? Doch eigentlich nicht?! Es geht ja lediglich um den File-Name, den Excel darstellen soll....
Das Makro läuft bis zum ersten Angebot und bleibt stehen. Wenn ich das Makro "Schrittweise" laufen lasse F8 fängt er wieder bei der ersten Datei von vorne an...
Wäre wirklich toll, wenn Du da nochmal drüber schauen könntest...
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 25_000\06-2005\")
On Error GoTo Fehler
'Application.ScreenUpdating = False
For Each f In fo.Files
Workbooks.Open (f.Path)
'Übersicht nächste freie Zeile, Spalte Kd-Nr.
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0) = _
Workbooks(f.Name).Sheets(2).Range("B2")
'Übersicht nächste freie Zeile, Spalte Kd-Name
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 1) = _
Workbooks(f.Name).Sheets(2).Range("B3")
'Übersicht nächste freie Zeile, Spalte Kd-Ort
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 2) = _
Workbooks(f.Name).Sheets(2).Range("B4")
'Übersicht nächste freie Zeile, Spalte AN-Nr.
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 3) = _
Workbooks(f.Name).Sheets(2).Range("B5")
'Übersicht nächste freie Zeile, Spalte AN-Volumen
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 4) = _
Workbooks(f.Name).Sheets(2).Range("B7")
'Übersicht nächste freie Zeile, Spalte AN-Positionen
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 5) = _
Workbooks(f.Name).Sheets(2).Range("B8")
'Übersicht nächste freie Zeile, Spalte AN-Innendienst
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 6) = _
Workbooks(f.Name).Sheets(2).Range("d2")
'Übersicht nächste freie Zeile, Spalte AN-Außendienst
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 7) = _
Workbooks(f.Name).Sheets(2).Range("d3")
'Übersicht nächste freie Zeile, Spalte AN-Abteilungsleiter
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 8) = _
Workbooks(f.Name).Sheets(2).Range("d4")
'Übersicht nächste freie Zeile, Spalte AN-Besuchsfregquenz
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 9) = _
Workbooks(f.Name).Sheets(2).Range("d5")
'Übersicht nächste freie Zeile, Spalte AN-Abgabetermin
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 10) = _
Workbooks(f.Name).Sheets(2).Range("k3")
'Übersicht nächste freie Zeile, Spalte AN-Status
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 11) = _
Workbooks(f.Name).Sheets(2).Range("h9")
'Übersicht nächste freie Zeile, Spalte AN-Hyperlink
ThisWorkbook.Sheets(1).Hyperlinks.Add Anchor:= _
ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(0, 12), _
Address:=f.Path, TextToDisplay:=f.Path
Workbooks(f.Name).Close False
Next f
Fehler:
Application.ScreenUpdating = True
End Sub
Anzeige