Sub Zeichen_in_Zeilen_Trennen()
Dim Str0 As String
Dim Str1 As String
Dim LaufZahl As Long
Dim Teil As Long
Dim CurLine As Long
Dim CurCol As Long
CurLine = 1
Application.ScreenUpdating = False
Application.EnableEvents = False
With ActiveSheet
Do
Str0 = .Cells(CurLine, 2)
If Len(Str0) > 60 Then
Do
For LaufZahl = 60 To 1 Step -1
If Mid(Str0, LaufZahl, 1) = " " Or Mid(Str0, LaufZahl, 1) = Chr(13) _
Or Mid(Str0, LaufZahl, 1) = Chr(10) Then
.Cells(CurLine + 1, 1).Select
Selection.EntireRow.Insert xlShiftDown
.Cells(CurLine + 1, 1) = Left(Str0, LaufZahl - 1)
Str0 = Right(Str0, Len(Str0) - LaufZahl)
CurLine = CurLine + 1
If Str0 <> "" Then
If Len(Str0) <= 60 Then
.Cells(CurLine + 1, 1).Select
Selection.EntireRow.Insert xlShiftDown
.Cells(CurLine + 1, 1) = Str0
CurLine = CurLine + 2
Exit Do
Else
Exit For
End If
End If
End If
Next LaufZahl
Loop
Else
.Cells(CurLine + 1, 1).Select
Selection.EntireRow.Insert xlShiftDown
.Cells(CurLine + 1, 1) = Str0
CurLine = CurLine + 2
End If
If .Cells(CurLine, 2) = "" Then Exit Do
Loop
.Cells(1, 2).EntireColumn.Delete
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub