Sub FilesListen()
Call EventsOff
Dim Dateien As Integer
Dim DateiName As String
Dim zeile As Long
With Application.FileSearch
.NewSearch
Rem pfad anpassen fuer die zu lesenden dateien
.LookIn = "F:\Temp\"
.Filename = "*.xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
If DateiName <> ThisWorkbook.Name Then
zeile = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Rem pfad anzupassen
Rem tabellennamen anzupassen,ich bin von der selben namensgebung der tabellen ausgegangen,zur zeit ist der name der tabelle Tabelle1
ThisWorkbook.ActiveSheet.Range("A" & zeile) = _
ExecuteExcel4Macro("'F:\Temp\" & "[" & DateiName & "]Tabelle1" & "'!" & Range("C35").Address(, , xlR1C1))
End If
Next Dateien
End If
End With
Call EventsOn
End Sub
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub