Option Explicit

Sub OpenTextFile()
  Dim varRetVal     As Variant
  Dim strFileName   As String

  ChDrive ThisWorkbook.Path
  ChDir ThisWorkbook.Path

  varRetVal = Application.GetOpenFilename( _
        FileFilter:="Text-Dateien (*.txt), *.txt", _
        Title:="Daten aus Text-Datei importieren")

  If varRetVal = False Then Exit Sub

  strFileName = varRetVal

  Workbooks.OpenText Filename:=strFileName, StartRow:=1, _
      DataType:=xlDelimited, TextQualifier:=xlNone, _
      ConsecutiveDelimiter:=True, Space:=True

  Dim wkb As Workbook
  Dim wks As Worksheet

  Set wkb = ActiveWorkbook

  strFileName = ThisWorkbook.Path & "\NeueXLDatei.xls"
  wkb.SaveAs Filename:=strFileName, FileFormat:=xlWorkbookNormal

  Set wks = wkb.Worksheets(1)
  wks.Name = "VB-fun-Demo"
  wks.UsedRange.Columns.AutoFit

  Set wks = Nothing
  Set wkb = Nothing
End Sub