Перенос слов на новую строку.

Попробуйте так (слова, состоящие из 3-х и менее символов выносятся на отдельную строку)

Sub tt()
    Dim i As Long
    With ActiveDocument.Range.Words
        For i = .Count To 1 Step -1
            If (Len(Trim(.Item(i).Text)) < 4) And AscW(Right(.Item(i).Text, 1)) <> 13 Then
                .Item(i).InsertAfter (vbCrLf)
                .Item(i).InsertBefore (vbCrLf)
            End If
        Next
    End With
End Sub

В Вашем перво сообщении ни слова не было про то, что переносить необходимо не все слова из 3- символов, а только те, которые стоят в конце строки. Тем более, что при изменении форматирования текста, ширины полей и т.п. конец строки начнет "плавать".
Что касается поиска конца строки, как такового, посмотрите здесь http://wordexpert.ru/forum/viewtopic.php?id=122