habe in einer Spalte Text stehen der immer mit einem fettgedruckten Textteil anfängt. Ich möchte alles was nach dem fettgedrucktem steht (also nicht fett ist) in Spalte 2 verschieben.
Danke,
Uwe
Option Explicit
Sub Trennen()
Dim Zelle As Range
Dim i As Integer
On Error GoTo Fehler
Application.ScreenUpdating = False
For Each Zelle In Range(Cells(1, 1), Cells(Range("A1").End(xlDown).Row, 1))
i = 0
Do
i = i + 1
Loop Until Not Zelle.Characters(i, 1).Font.Bold
Zelle.Offset(0, 1) = Mid(Zelle, i)
Zelle = Left(Zelle, i - 1)
Next
Fehler:
Application.ScreenUpdating = True
Set Zelle = Nothing
End Sub
Option Explicit
Sub Trennen()
Dim Zelle As Range
Dim i As Integer, p As Integer
On Error GoTo Fehler
Application.ScreenUpdating = False
For Each Zelle In Range(Cells(1, 1), Cells(Range("A1").End(xlDown).Row, 1))
i = 0
p = Len(Zelle)
Do
i = i + 1
Loop Until Not Zelle.Characters(i, 1).Font.Bold Or i > p
Zelle.Offset(0, 1) = Mid(Zelle, i)
Zelle = Left(Zelle, i - 1)
Next
Fehler:
Application.ScreenUpdating = True
Set Zelle = Nothing
End Sub