Sub FReditCopy()
' Paul Beverley - Version 20.01.16
' Copy word to make FRedit script item

Selection.EndKey Unit:=wdLine
Selection.MoveStartWhile cset:=ChrW(124) & Chr(9) & " ", count:=wdBackward
If Selection <> Chr(13) Then Selection.Delete
Selection.Expand wdParagraph
Selection.MoveEnd , -1
Selection.Copy
Selection.Collapse wdCollapseEnd
Selection.TypeText ChrW(124)
Selection.Paste
Selection.MoveRight , 1
End Sub