Sub WörterTrennen()
Dim Tabelle As Object
Dim Satz As String
Dim Zeile As Long
Set Tabelle = Application.ActiveSheet
Satz = Tabelle.Cells(1, 1).Value
Satz = Replace(Satz, ".", "")
Satz = Replace(Satz, ":", "")
Zeile = 2
Do While Satz <> ""
If InStr(1, Satz, " ") > 1 Then
Tabelle.Cells(Zeile, 1).Value = Mid(Satz, 1, InStr(1, Satz, " "))
Satz = Mid(Satz, InStr(1, Satz, " ") + 1)
Zeile = Zeile + 1
Else
Tabelle.Cells(Zeile, 1).Value = Mid(Satz, 1)
Satz = ""
End If
Loop
End Sub