Sub Zusammenführen()
Dim oTargetBook As Object
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Application.ScreenUpdating = False
Appliation.DisplayAlerts = False
Set oTargetBook = ActiveWorkbook
sPfad = "\\dehgnt\dfs-hf\DE\Schiltach\dep_Controlling-WSA\07 Monatsabschluss\ILV Makros\Stundenerfassung"
sDatei = Dir(CStr(sPfad & "*.xl*"))
Do While sDatei <> ""
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True)
oSourceBook.Sheets().Copy after:=oTargetBook.Sheets(oTargetBook.Sheets.Count)
On Error Resume Next
oTargetBook.Sheets(oTargetBook.Sheets.Count).Name = sDatei
If Err.Number <> 0 Then
Err.Numer = 0
Err.Clear
End If
On Error GoTo 0
oSourceBook.Close False
End Sub