|  
                                             
	Mal auf die schnelle. Ohne den Ursprungscode zu begutachten. So sollte es funktionieren. Bitte Daten vorab sichern ! 
	Die Kommentare zeigen wo eine neue Codezeile hinzugefügt bzw. wo eine Codezeile überarbeitet wurde 
	  
Private Sub TextSpalter()
    Dim i As Long
    Dim s As String
    Dim Zeile As Long                           'NEU
    Zeile = 1                                   'NEU
    
    Do While Cells(Zeile, 1) <> ""              'NEU
    
        s = Cells(Zeile, 1)                     '1 durch Zeile ersetzt
        i = InStrRev(s, " ", 30, vbTextCompare)
        
        If i > 0 Then
            Cells(Zeile, 1) = Left$(s, i - 1)   '1 durch Zeile ersetzt
            Cells(Zeile, 2) = Mid$(s, i + 1)    '1 durch Zeile ersetzt
        End If
        
        s = Cells(Zeile, 2)                     '1 durch Zeile ersetzt
        i = InStrRev(s, " ", 30, vbTextCompare)
        
        If i > 0 Then
            Cells(Zeile, 2) = Left$(s, i - 1)   '1 durch Zeile ersetzt
            Cells(Zeile, 3) = Mid$(s, i + 1)    '1 durch Zeile ersetzt
        End If
    
        Zeile = Zeile + 1                       'NEU
    Loop                                        'NEU
    
End Sub
	  
     |