Sub test()
Dim Arbeit, i, zeile
Dim oWbTo As Excel.Workbook
Dim oWbFrom As Excel.Workbook
Arbeit = Application.GetOpenFilename _
(MultiSelect:=True)
If IsArray(Arbeit) Then
Application.ScreenUpdating = False
Workbooks.Add
Set oWbTo = ActiveWorkbook
zeile = 1
For i = 1 To UBound(Arbeit)
Set oWbFrom = Workbooks.Open(Arbeit(i), local:=True)
With oWbFrom.Sheets(1)
.UsedRange.Copy Destination:=oWbTo.Sheets(1).Range("A" & zeile)
zeile = oWbTo.Sheets(1).UsedRange.Rows.Count + 1
End With
oWbFrom.Close False
Next i
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Set oWbFrom = Nothing
Set oWbTo = Nothing
End Sub