First letter Macro

This macro removes everything except the initial letter of the words. Makes it easier for me to learn ritual


Sub Martin()
'
' Martin Macro
'
'
    Do
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.Delete Unit:=wdWord, Count:=1
        Selection.MoveRight Unit:=wdWord, Count:=1
    Loop Until (Selection.End = ActiveDocument.Content.End - 1)
End Sub