With Application.FileSearch
.LookIn = "Z:\Anw\kore\excel\"
.SearchSubFolders = True
.FileName = "*sel-ad.xls"
If .Execute > 0 Then
MsgBox "Es wurde(n) " & .FoundFiles.Count & " Datei(en) gefunden."
For i = 1 To .FoundFiles.Count
dateiname = .FoundFiles(i)
Workbooks.Open FileName:=dateiname, _
updatelinks:=0
Range("F4:I6").Select
Selection.Copy
Windows("Übersicht Sel-Ad.xls").Activate
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("D2").Select
Windows(dateiname).Activate ????????????