Flytte vilkårlig tekst i celle indtil der kommer et mellemrum?

Sub ChangeTextSingleCell()
    Dim str1 As String
   
    With  Range("B11")
        str1 = .Value
        .Offset(0, -1) = Trim(Left(str1, InStr(1, str1, " ")))
        .Value = Trim(Replace(.Value, .Offset(0, -1), ""))
    End With
   
End Sub





Sub ChangeTextRange()
    Dim rngData As Range
    Set rngData = Range("B1", Range("B65536").End(xlUp))
   
    With rngData
        .Offset(0, -1) = "=LEFT(RC[1], FIND("" "",RC[1]))"
        .Offset(0, -1) = .Offset(0, -1).Value
        .Offset(0, 1) = "=SUBSTITUTE(RC[-1],RC[-2],"""")"
        .Offset(0, 1) = .Offset(0, 1).Value
        .EntireColumn.Delete
    End With
End Sub

har ikke lige testet endnu, men det burde være ok...