Sub FilesListen()
Call EventsOff
Dim Dateien As Integer
Dim DateiName As String
With Application.FileSearch
.NewSearch
Rem der der quellpfad sollte angepasst werden
.LookIn = "C:\Temp\"
.Filename = "*.xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
If DateiName <> ThisWorkbook.Name Then
Workbooks.Open Filename:=.FoundFiles(Dateien)
Rem der auszulesende bereich sollte angepasst werden
Workbooks(DateiName).Sheets("Tabelle1").Range("A2:U" & Workbooks(DateiName).Sheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy ThisWorkbook.Sheets("Tabelle1").Range("A" & ThisWorkbook.Sheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Workbooks(DateiName).Close SaveChanges:=True
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