Option Explicit

Sub Zusammenführen()
Dim arrFiles() As Variant, x As Long
Dim flag As Boolean, rflag As Long
Dim rngToC As Range
On Error GoTo FilesFail

If Application.WorksheetFunction.CountA(Cells) = 0 Then flag = True

Application.ScreenUpdating = False
Application.DisplayAlerts = False
   arrFiles = AskForFiles
   For x = LBound(arrFiles) To UBound(arrFiles)
      Workbooks.Open Filename:=arrFiles(x), ReadOnly:=True
      If Application.WorksheetFunction.CountA(Cells) = 0 Then
         Workbooks(2).Close
      Else
         Set rngToC = ActiveSheet.UsedRange
         If flag = True Then
            rngToC.Copy
         Else
            rflag = rngToC.Rows.Count
            If rflag > 5 Then _
            Set rngToC = rngToC.Offset(5, 0).Resize(rngToC.Rows.Count - 5, rngToC.Columns.Count)
            rngToC.Copy
         End If
         Workbooks(2).Close
         If flag = True Then
            ActiveSheet.Paste Cells(1)
            flag = False
         Else
            If rflag > 5 Then _
            ActiveSheet.Paste Cells(Rows.Count, 1).End(xlUp).Offset(1)
         End If
         Application.CutCopyMode = False
      End If
   Next x

FilesFail:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Select Case Err.Number
   Case 0
   Case 9
      MsgBox "keine Auswahl", vbOKOnly Or vbCritical, "Abbruch"
      End
   Case Else
      MsgBox "Fehler im Dateiaufbau", vbOKOnly Or vbCritical, "Abbruch"
      End
End Select

End Sub


Private Function AskForFiles() As Variant
Dim oFilePicker As Office.FileDialog
Dim varItem As Variant
Dim arrSelected() As Variant, x As Long
'
On Error GoTo NoFile
Set oFilePicker = Application.FileDialog(MsoFileDialogType.msoFileDialogFilePicker)
With oFilePicker
   .AllowMultiSelect = True
   .ButtonName = "Übernehmen"
   .Filters.Clear
   .Filters.Add "Excel", "*.xls; *.xlsx; *.xlsm"
   .InitialView = msoFileDialogViewList
   .Title = "Auswahldialog"
   If .Show = -1 Then
      ReDim arrSelected(1 To .SelectedItems.Count)
      For Each varItem In .SelectedItems
         x = x + 1: arrSelected(x) = varItem
      Next varItem
   End If
End With
NoFile:
On Error GoTo 0
Select Case Err.Number
   Case 0
      AskForFiles = arrSelected
   Case Else
      MsgBox "Fehler in der Dateiauswahl", vbOKOnly Or vbCritical, "Abbruch"
      End
End Select
End Function