Sub DatenEinlesenNEU()
Dim strDatei As String
Tabelle1.Rows.Clear
Zeile = 1
pfad = "C:\Desktop\Ordner\"
strDatei = Dir(pfad & "*.dat")
Do While strDatei <> ""
Workbooks.OpenText Filename:="C:\Desktop\Ordner\*.DAT", _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
Array(0, 9), Array(18, 1), Array(25, 9)), DecimalSeparator:=".", _
ThousandsSeparator:=",", TrailingMinusNumbers:=True
Set Quelle = ActiveWorkbook
Quelle.Worksheets(1).UsedRange.Copy Destination:=Tabelle1.Cells(Zeile, 1)
Quelle.Close savechanges:=False
strDatei = Dir
Zeile = Tabelle1.UsedRange.Rows.Count + 1
Loop
End Sub