Sub Perenos()

for i = 1 to Selection.Rows.Count

S = RTrim(Left(Selection.Cells(i,1).Value,35))
SFull = Selection.Cells(i,1).Value

BlankCounter = 0

if Mid(SFull,36,1) <> " " and Len(S) = 35 tnen SplitWord = True else SplitWord = False

LastWord = Right(S,1)

for j = Len(S)-1 to 1 step -1

  if Mid(S, j, 1) = " "
    then
       if Mid(S, j+1,1)<>" " then  BlankCounter = BlankCounter + 1
       if BlankCounter = 1 and SplitWord then LastWord = ""
       if BlankCounter = 1 and not SplitWord or BlankCounter = 2
         then
           LastWordPosition = j+1
           Exit for
       End if
     else
       LastWord = Mid(S,j,1) & LastWord
  End if

Next j

if LastWord = "от" or LastWord = "на" or LastWord = "ещекакойнибудьпредлог"  
  then
    Selection.Cells(i,2).Value = Left(SFull, LastWordPosition-1)
    Selection.Cells(i,3).Value = Right(SFull, Len(SFull) -  LastWordPosition+1)
  else
    Selection.Cells(i,2).Value = Left(SFull, LastWordPosition + Len(LastWord))
    Selection.Cells(i,3).Value = Right(SFull, Len(SFull) -  LastWordPosition - Len(LastWord)+1)
end if

Next i

End Sub

Sub Perenos()
For i = 1 To Selection.Rows.Count
SFull = Replace(Selection.Cells(i, 1).Value, " р.", "~р.")
SFull = Replace(SFull, " руб.", "~руб.")
SFull = Replace(SFull, " грн.", "~грн.")
For j = 1 To Len(SFull)
  If Mid(SFull, j, 1) = " " And Mid(SFull, j + 1, 1) Like "[0-9]" Then SFull = Left(SFull, j - 1) & "~" & Right(SFull, Len(SFull) - j)
Next j
S = RTrim(Left(SFull, 35))
BlankCounter = 0
If Mid(SFull, 36, 1) <> " " And Len(S) = 35 Then SplitWord = True Else SplitWord = False
LastWord = Right(S, 1)
For j = Len(S) - 1 To 1 Step -1
If Mid(S, j, 1) = " " Then
    If Mid(S, j + 1, 1) <> " " Then BlankCounter = BlankCounter + 1
    If BlankCounter = 1 And SplitWord Then LastWord = ""
    If BlankCounter = 1 And Not SplitWord Or BlankCounter = 2 Then
        LastWordPosition = j + 1
        Exit For
    End If
    Else
    LastWord = Mid(S, j, 1) & LastWord
End If
Next j
SFull = Replace(SFull, "~", " ")
If LastWord = "от" Or LastWord = "на" Or LastWord = "ещекакойнибудьпредлог" Then
    Selection.Cells(i, 2).Value = Left(SFull, LastWordPosition - 1)
    Selection.Cells(i, 3).Value = Right(SFull, Len(SFull) - LastWordPosition + 1)
Else
    Selection.Cells(i, 2).Value = Left(SFull, LastWordPosition + Len(LastWord))
    Selection.Cells(i, 3).Value = Right(SFull, Len(SFull) - LastWordPosition - Len(LastWord) + 1)
End If
Next i
End Sub