Public Sub Aufteilen_I()
Dim iZeile As Integer
Dim lSpalte As Integer
Dim iSpalte As Integer
Dim iPosit As Integer
Application.ScreenUpdating = False
For iZeile = 1 To Range("A65536").End(xlUp).Row
lSpalte = Cells(iZeile, 256).End(xlToLeft).Column
If lSpalte < 3 Then lSpalte = 3
Range(Cells(iZeile, 3), Cells(iZeile, lSpalte)).ClearContents
iSpalte = 3
For iPosit = 1 To Len(Range("A" & iZeile).Value)
If Mid(Range("A" & iZeile).Value, iPosit, 1) = Chr(10) Then
iSpalte = iSpalte + 1
Else
Cells(iZeile, iSpalte).Value = Cells(iZeile, iSpalte).Value & _
Mid(Range("A" & iZeile).Value, iPosit, 1)
End If
Next iPosit
Next iZeile
Application.ScreenUpdating = True
End Sub