Try this:
Sub x()
    Const iMax  As Long = 30
    Dim r       As Range
    Dim cell    As Range
    Dim sCAR    As String
    Dim sCDR    As String
    Dim iPos    As Long

    Set r = Intersect(Selection, ActiveSheet.UsedRange)
    
    For Each cell In r
        If Not (cell.HasFormula Or IsEmpty(cell.Value)) Then
            sCDR = cell.Value
            sCAR = vbNullString
            Do Until Len(sCDR) = 0
                iPos = InStrRev(Left(sCDR, iMax), " ")
                If iPos = 0 Then iPos = InStr(sCDR, " ")
                If iPos = 0 Then iPos = Len(sCDR)
                sCAR = sCAR & vbLf & Left(sCDR, iPos)
                sCDR = Mid(sCDR, iPos + 1)
            Loop
            cell.Value = Mid(sCAR, 2)
        End If
    Next cell
End Sub