Gruppe
Allgemein
Problem
Aus den Dateien des in Zelle B1 genannten Verzeichnisses soll jeweil ein Bereich mit dem Namen "others" importiert werden.
StandardModule: Modul1
Sub ImportOthers()
Dim fs As FileSearch
Dim lRow As Long
Dim iCounter As Integer
Application.ScreenUpdating = False
Set fs = Application.FileSearch
lRow = 1
With fs
.Filename = "*.xls"
.LookIn = Range("B1").Value
.Execute
For iCounter = 1 To .FoundFiles.Count
Cells(lRow, 1).Value = .FoundFiles(iCounter)
lRow = lRow + 1
Workbooks.Open .FoundFiles(iCounter)
Range("other").Copy ThisWorkbook.Worksheets(1).Cells(lRow, 1)
lRow = lRow + Range("other").Rows.Count + 2
ActiveWorkbook.Close savechanges:=False
Next iCounter
End With
Application.ScreenUpdating = True
End Sub