Sub KW_Wechseln()
Dim p$
p = Range("B1").Value
ActiveCell.Formula = _
"=IF('C:\Dokumente und Einstellungen\haenselm.STUWE_DD\Desktop\Speiseplan2003\Mensen\[vmb.xls]" & (p) & ".KW'!R3C3:R7C3>0, 'C:\Dokumente und Einstellungen\haenselm.STUWE_DD\Desktop\Speiseplan2003\Mensen\[vmb.xls]" & (p) & ".KW'!R3C3:R7C3)"
End Sub
Sub Daten_einlesen()
Dim vFile As Variant
Dim Lvarfile As Single
Dim LvFile As Single
Dim p$, d$
'evtl. vorhandenen Bereich mit alten Daten markieren und löschen
Range("a2").Select
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(0, 0).Select
Selection.Delete
' Überschriften schreiben
Range("a1").Value = "Pfad"
Range("b1").Value = "Datei"
Range("c1").Value = "Inhalt aus Zelle a2"
Range("d1").Value = "Inhalt aus Zelle b2"
i = 1
With Application.FileSearch
.NewSearch
' Eingabe des Pfades der ausgelesen werden soll
'Bei fesgelegtem Pfad die beiden nächstenZeilen löschen und dritte Zeile wie folgt
'.LookIn = "C:\Eigene Dateien"
Dim Ordner$
Ordner = InputBox("Verzeichnis:", , "C:\Eigene Dateien")
.LookIn = Ordner
.Filename = "*.xls"
' Wenn Unterverzeichnisse nicht durchsucht werden sollen, .SearchSubFolders = False
.SearchSubFolders = True
If .Execute() > 0 Then
For Each varfile In .FoundFiles
vFile = varfile
vFile = Dir(vFile)
Lvarfile = Len(CStr(varfile))
LvFile = Len(CStr(vFile))
pathleft = Left(varfile, (Lvarfile - LvFile))
Cells(i + 1, 1).Value = pathleft
Cells(i + 1, 3).Select
p = "'" & pathleft & "["
d = vFile
'Formeln in Zellen schreiben
ActiveCell.Offset(rowOffset:=0, columnOffset:=0).Activate
ActiveCell.Formula = "=" & (p) & (d) & "]Tabelle1'!$a$2"
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Formula = "=" & (p) & (d) & "]Tabelle1'!$b$2"
Cells(i + 1, 2).Value = vFile
i = i + 1
Next varfile
End If
End With
Range("A1").Select
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen