AW: Zellen auf versch. Dateinen auslesen
09.10.2007 08:28:00
Chaos
Servus,
z.B. so:
Sub öffnen()
Dim Dateien As Long
Dim pfad As String, DateiName As String, Dateipfad As String
Dim wkbQuelle As String, wkbZiel As String
Dim wksQuelle As String, wksZiel As String
pfad = "C:\..." ' Hier dein Pfad
wkbZiel = ActiveWorkbook.Name
wksZiel = ActiveWorkbook.Sheets(1).Name
With Application.FileSearch ' Öffnet alle Dateien im angegebenen Pfad und schreibt in die _
Zieltabelle fortlaufend in Spalte A den Hyperlink, in Spalte B B27 und in Spalte C C27.
On Error Resume Next
.NewSearch
.LookIn = pfad
.Filename = "*" & ".xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
Dateipfad = .FoundFiles(Dateien)
If DateiName ThisWorkbook.Name Then
Workbooks.Open Filename:=.FoundFiles(Dateien)
wkbQuelle = ActiveWorkbook.Name
wksQuelle = ActiveWorkbook.Sheets(1).Name
Workbooks(wkbZiel).Sheets(wksZiel).Hyperlinks.Add Anchor:=Workbooks(wkbZiel). _
Sheets(wksZiel).Range("A65536").End(xlUp).Offset(1, 0), Address:=Dateipfad, _
TextToDisplay:=Dateipfad
Workbooks(wkbQuelle).Sheets(wksQuelle).Range("B27").Copy Workbooks(wkbZiel). _
Sheets(wksZiel).Range("B65536").End(xlUp).Offset(1, 0)
Workbooks(wkbQuelle).Sheets(wksQuelle).Range("C27").Copy Workbooks(wkbZiel). _
Sheets(wksZiel).Range("C65536").End(xlUp).Offset(1, 0)
Workbooks(wkbQuelle).Close
End If
Next
End If
End With
End Sub
Gruß
Chaos