So, ist ja schon ein neuer Tag. :-) Also wie versprochen hier mal eine andere Variante. Liest aus den Dateien zeilenweise den Text und trägt ihn dann ein. Schau mal bitte, ob das klappt oder wieder Fehlermeldungen kommen (sollte eigentlich nicht mehr passieren :-) ). Gruß

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
     
    ReDim dateien(0)
    dateien(0) = 0
     
    quelle = "Y:\Eigene Dateien\Bearbeitung\bearbeiten\makro\neu"
    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()
        
        Open DateiName For Input As #nr
        Do While Not EOF(nr)
        
            Line Input #nr, zeile
            
            inhalt = Split(zeile, Chr(9))
            For j = 0 To UBound(inhalt)
                If IsNumeric(inhalt(j)) Then inhalt(j) = Replace(inhalt(j), ",", ".")
                ActiveSheet.Cells(ende, 3 + j) = inhalt(j)
            Next j
            ende = ende + 1
        Loop
        
        Close #nr
 
        Next i
    End If
      
    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