Public Function ReadDataTextFile(ByVal sFileName As String, _
      ByVal sDelimiter As String, ByVal wksDest As Worksheet, _
      Optional ByVal fClearContents As Boolean = True) As Boolean

  Dim FN            As Integer
  Dim strLineText   As String

  Dim avarData      As Variant
  Dim avarItems     As Variant
  Dim avarWksData   As Variant

  Dim nRowsCnt      As Long
  Dim nColsCnt      As Long
  Dim nItemsCnt     As Long

  Dim nColsMax      As Long

  Dim nRow          As Long
  Dim nCol          As Long

  Dim varValue      As Variant

  nRowsCnt = -1
  ReDim avarData(0 To 0)

  FN = FreeFile()
  Open sFileName For Input As #FN
    While Not EOF(FN)
      Line Input #FN, strLineText
      nRowsCnt = nRowsCnt + 1
      If (nRowsCnt Mod 100) = 0 Then
        ReDim Preserve avarData(0 To nRowsCnt + 100)
      End If
      avarData(nRowsCnt) = strLineText
    Wend
  Close #FN

  If nRowsCnt > -1 Then
    ReDim Preserve avarData(0 To nRowsCnt)
  Else
    MsgBox "Keine Daten in Text-Datei enthalten!", _
            vbOKOnly + vbInformation, "VB-fun-Demo"
    Exit Function
  End If

  On Error GoTo err_ReadData

  nColsMax = wksDest.Columns.Count - 1
  nColsCnt = 0

  ReDim avarWksData(0 To nRowsCnt, 0 To nColsCnt)

  For nRow = 0 To UBound(avarData)
    avarItems = Split(avarData(nRow), sDelimiter)
    If UBound(avarItems) > -1 Then
      nItemsCnt = UBound(avarItems)
      If nItemsCnt > nColsCnt Then
        nColsCnt = nItemsCnt
        If nColsCnt > nColsMax Then
          nColsCnt = nColsMax
          nItemsCnt = nColsMax
        End If
        ReDim Preserve avarWksData(0 To nRowsCnt, 0 To nColsCnt)
      End If

      For nCol = 0 To nItemsCnt
        varValue = avarItems(nCol)
        avarWksData(nRow, nCol) = varValue
      Next
    End If
  Next

  If fClearContents Then
    wksDest.Cells.ClearContents
    nRow = 1
  Else
    With wksDest
      If Application.WorksheetFunction.CountA(.Cells) > 0 Then
        nRow = .Cells.Find(What:="*", After:=.Range("A1"), _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious).Row + 1
      Else
        nRow = 1
      End If
    End With
  End If

  If nRow + UBound(avarWksData, 1) > wksDest.Rows.Count Then
    Err.Raise vbObjectError + 513

  Else
    With wksDest
      wksDest.Cells(nRow, 1).Resize(UBound(avarWksData, 1) + 1, _
            UBound(avarWksData, 2) + 1) = avarWksData
    End With

    ReadDataTextFile = True
  End If

exit_Func:
  On Error GoTo 0
  Exit Function

err_ReadData:
  Dim strErrMsg As String

  Select Case Err.Number
    Case vbObjectError + 513
      strErrMsg = "Zu viele Zeilen. " & vbCr & _
            "Daten können nicht importiert werden!"

    Case Else
      strErrMsg = "Fehler-Nr. " & Err.Number & vbCr & _
            Err.Description
  End Select

  MsgBox strErrMsg, vbOKOnly + vbCritical, _
        "VB-fun-Demo - Daten aus Textdatei importieren"
    Resume exit_Func
End Function

Sub ReadDataTextFile_Start()
  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

  Dim wksDest As Worksheet
  Set wksDest = ActiveWorkbook.Worksheets.Add

  If ReadDataTextFile(strFileName, ";", wksDest, False) Then
      MsgBox "Das Importieren der Daten war erfolgreich!", _
            vbOKOnly + vbInformation, _
            "VB-fun-Demo - Daten aus Textdatei importieren"
  End If

  Set wksDest = Nothing
End Sub

Public Function SaveDataTextFile(ByVal rngSrc As Range, _
     ByVal sFileName As String, ByVal sDelimiter As String) _
     As Boolean

  Dim avarWksData   As Variant

  Dim nRowsCnt      As Long
  Dim nColsCnt      As Long

  Dim nRow          As Long
  Dim nCol          As Long

  Dim FN            As Integer
  Dim strFileText   As String

  On Error GoTo err_SaveData

  avarWksData = rngSrc.Value

  nRowsCnt = UBound(avarWksData, 1)
  nColsCnt = UBound(avarWksData, 2)

  FN = FreeFile()
  Open sFileName For Output As #FN
    For nRow = 1 To nRowsCnt
      For nCol = 1 To nColsCnt - 1
        strFileText = strFileText & avarWksData(nRow, nCol) & _
                         sDelimiter
      Next
      strFileText = strFileText & avarWksData(nRow, nColsCnt)

      Print #FN, strFileText
      strFileText = ""
    Next
  Close #FN

  SaveDataTextFile = True

exit_Func:
  On Error GoTo 0
  Exit Function

err_SaveData:
  MsgBox "Fehler-Nr. " & Err.Number & vbCr & Err.Description, _
        vbOKOnly + vbCritical, _
        "VB-fun-Demo - Daten in Textdatei exportieren"
  Resume exit_Func
End Function

Sub SaveDataTextFile_Start()
  Dim varRetVal     As Variant
  Dim strInitName   As String
  Dim strFileName   As String

  Dim strDelimiter  As String

  ChDrive ThisWorkbook.Path
  ChDir ThisWorkbook.Path

  strInitName = "Test"
  varRetVal = Application.GetSaveAsFilename( _
        InitialFilename:=strInitName, _
        FileFilter:="Text-Dateien (*.txt), *.txt", _
        Title:="Daten exportieren in Text-Datei")

  If varRetVal = False Then Exit Sub

  strFileName = varRetVal
  strDelimiter = ";"

  Dim wksSrc As Worksheet
  Dim rngSrc As Range

  If UCase$(TypeName(ActiveWorkbook.ActiveSheet)) = _
        "WORKSHEET" Then
    Set wksSrc = ActiveWorkbook.ActiveSheet
  Else
    MsgBox "Bitte aktivieren Sie ein Tabellenblatt " & _
           "und versuchen Sie es erneut!", vbInformation, _
          "VB-fun-Demo - Daten in Textdatei exportieren"
    Exit Sub
  End If

  Set rngSrc = wksSrc.UsedRange
  If SaveDataTextFile(rngSrc, strFileName, strDelimiter) Then
    MsgBox "Das Exportieren der Daten war erfolgreich!", _
             vbOKOnly + vbInformation, _
             "VB-fun-Demo - Daten in Textdatei exportieren"
  End If

  Set rngSrc = Nothing
  Set wksSrc = Nothing
End Sub