Hi! It's quite simple:
Code:
Sub Move_Two_Lines_Down()
Dim Rng As range
Set Rng = selection.range
Application.ScreenUpdating = False
Do
With Rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.text = "Keywords ^#"
.Forward = True
.Format = True
.Wrap = wdFindStop
.MatchWildcards = False
.Execute
If Rng.End > selection.range.End Then Exit Do
If .found Then
Rng.Paragraphs(1).range.Cut
Rng.Move unit:=wdParagraph, count:=2
Rng.Paste
Rng.Collapse wdCollapseEnd
Else: Exit Do
End If
End With
Loop
Application.ScreenUpdating = True
Set Rng = Nothing
End Sub
Replace 'Keywords' with your word. If you want to work on the whole doc either press Ctrl+A or replace 'selection.range' with 'ActiveDocument.range'.