Sub Makro()
Dim iMappe As Integer
Dim neuDatei As Workbook, WS As Worksheet
Application.ScreenUpdating = False
Set neuDatei = Workbooks.Add
Set WS = neuDatei.Worksheets(1)
For iMappe = 1 To Workbooks.Count
If Workbooks(iMappe).Name <> neuDatei.Name Then
WS.Cells(WS.Range("A65536").End(xlUp).Row + 1, 1) = _
Workbooks(iMappe).Worksheets(1).Range("A1")
End If
Next iMappe
WS.Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.ScreenUpdating = True
End Sub