Und hier die Version mit input line - sollte auch gehen!

Dim dateien()
Option Explicit
   
Sub DateienLesen()
    Call EventsOff
    Dim DateiName As String
    Dim quelle As String
    Dim i As Long
    Dim j As Long
    Dim zeile As String
    Dim inhalt
    Dim ende
    Dim nr
    Dim utf As Boolean
    Dim prüfen As Boolean
    Dim erstezeile As Boolean
    Dim text As String
    
    ReDim dateien(0)
    dateien(0) = 0
       
    quelle = "       " 'Pfad eintragen
    Call txtsuchen(quelle)
  
    If dateien(0) = 0 Then
    MsgBox "Keine .txt Dateien gefunden!"
    Else
    'Daten auslesen
          
        For i = 1 To dateien(0)
        DateiName = dateien(i)
        ende = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
        ende = ende + 2
         
        nr = FreeFile()
        utf = False
        prüfen = False
        erstezeile = False
         
        Open DateiName For Input As #nr
        Do While Not EOF(nr)
          
            Line Input #nr, zeile
              
            inhalt = Split(zeile, Chr(9))
             
            If prüfen = False Then
                If Len(inhalt(0)) > 2 Then
                    If Asc(Left(inhalt(0), 1)) = 239 And Asc(Mid(inhalt(0), 2, 1)) = 187 And Asc(Mid(inhalt(0), 3, 1)) = 191 Then utf = True
                End If
                prüfen = True
                text = inhalt(2)
            End If
                 
            For j = 0 To UBound(inhalt)
                                
                If utf = True Then
                    If erstezeile = False Then
                        If j = 0 Then inhalt(j) = Mid(inhalt(j), 4, Len(inhalt(j)))
                        If IsNumeric(inhalt(j)) Then inhalt(j) = Replace(inhalt(j), ",", ".")
                        ActiveSheet.Cells(ende, 3 + j) = FromUTF8String(inhalt(j))
                        erstezeile = True
                    Else
                        If IsNumeric(inhalt(j)) Then inhalt(j) = Replace(inhalt(j), ",", ".")
                        ActiveSheet.Cells(ende, 3 + j) = FromUTF8String(inhalt(j))
                    End If
                Else
                    If IsNumeric(inhalt(j)) Then inhalt(j) = Replace(inhalt(j), ",", ".")
                    ActiveSheet.Cells(ende, 3 + j) = inhalt(j)
                End If
            Next j
            ActiveSheet.Cells(ende, 6) = text
            ende = ende + 1
        Loop
          
        Close #nr
   
        Next i
    End If
    Call tausch
     
    ActiveSheet.Range("C:D").Columns.AutoFit
    ActiveSheet.Range("C:D").NumberFormat = "0.000000"
    Call EventsOn
End Sub
    
Public Sub EventsOff()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
End Sub
    
Public Sub EventsOn()
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub
  
Function txtsuchen(quelle As String)
Dim suche
Dim ordner()
Dim i As Long
   
ReDim ordner(0)
ordner(0) = 0
ChDrive (Left(quelle, 3))
ChDir (quelle)
  
'Ordner durchschauen
suche = Dir(quelle & "\*.*", vbDirectory)
   
Do Until suche = ""
    'Normale Dateien rausfiltern
    If (GetAttr(quelle & "\" & suche) = 16) Then
        'die hier ankommen, sind Ordner, extra speichern
        ordner(0) = ordner(0) + 1
        ReDim Preserve ordner(ordner(0))
        ordner(ordner(0)) = suche
    Else
        If Right(suche, 4) = ".txt" Then
            dateien(0) = dateien(0) + 1
            ReDim Preserve dateien(dateien(0))
            dateien(dateien(0)) = quelle & "\" & suche
        End If
    End If
           
    suche = Dir()
Loop
'jetzt durch die Ordner gehen
For i = 1 To UBound(ordner)
    If Dir(ordner(i), vbNormal) = "" And Left(ordner(i), 1) <> "." Then
        Call txtsuchen(quelle & "\" & ordner(i))
        ChDir (quelle)
    End If
Next
End Function
 
Function FromUTF8String(ByVal s As String) As String
   Dim i As Integer, b(2) As Byte
    
   i = 1
   s = s & Chr(0) & Chr(0)
   Do While i <= Len(s) - 2
      b(0) = Asc(Mid(s, i, 1))
      b(1) = Asc(Mid(s, i + 1, 1))
      b(2) = Asc(Mid(s, i + 2, 1))
      If (b(0) And &HE0) = &HE0 Then
         FromUTF8String = FromUTF8String & ChrW((b(0) And &HF) * CLng(&H1000) + (b(1) And &H3F) * CLng(&H40) + (b(2) And &H3F))
         i = i + 3
      ElseIf (b(0) And &HC0) = &HC0 Then
         FromUTF8String = FromUTF8String & ChrW((b(0) And &H1F) * &H40 + (b(1) And &H3F))
         i = i + 2
      Else
         FromUTF8String = FromUTF8String & Chr(b(0))
         i = i + 1
      End If
   Loop
End Function
 
Function tausch()
Dim i As Long
For i = 1 To ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
 
ActiveSheet.Cells(i, 5) = Replace(ActiveSheet.Cells(i, 5), Chr(195) & Chr(132), "Ä")
ActiveSheet.Cells(i, 5) = Replace(ActiveSheet.Cells(i, 5), Chr(195) & Chr(164), "ä")
ActiveSheet.Cells(i, 5) = Replace(ActiveSheet.Cells(i, 5), Chr(195) & Chr(150), "Ö")
ActiveSheet.Cells(i, 5) = Replace(ActiveSheet.Cells(i, 5), Chr(195) & Chr(182), "ö")
ActiveSheet.Cells(i, 5) = Replace(ActiveSheet.Cells(i, 5), Chr(195) & Chr(156), "Ü")
ActiveSheet.Cells(i, 5) = Replace(ActiveSheet.Cells(i, 5), Chr(195) & Chr(188), "ü")
ActiveSheet.Cells(i, 5) = Replace(ActiveSheet.Cells(i, 5), Chr(195) & Chr(159), "ü")
Next i
 
End Function