Sub Verbinden()
Dim LetzteZeile As Long
Dim curZeile As Long
Dim breakPos As Long
With ActiveSheet
LetzteZeile = .Cells(.Cells.Rows.Count, 2).End(xlUp).Row
For curZeile = 4 To LetzteZeile
breakPos = Instr(1, .cells(curZeile,2), Chr(10), vbBinaryCompare)
If breakPos <> 0 Then
.Cells(curZeile, 3) = Right(.Cells(curZeile, 2), Len(.Cells(curZeile, 2) - breakPos)
.Cells(curZeile, 2) = Left(.Cells(curZeile, 2), breakPos - 1)
End If
Next curZeile
End With
End Sub