Sub Move_Two_Lines_Down()
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  Application.ScreenUpdating = False
  With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "Keywords ^#"
    .Forward = True
    .Format = True
    .Wrap = wdFindStop
    While .Execute
      oRng.Paragraphs(1).Range.Cut
      oRng.Move unit:=wdParagraph, Count:=2
      oRng.Paste
      If oRng.End = ActiveDocument.Range.End - 1 Then
        oRng.InsertBefore vbCr
        oRng.Paragraphs.Last.Next.Range.Delete
      End If
       oRng.Collapse wdCollapseEnd
    Wend
  End With
  Application.ScreenUpdating = True
lblExit:
  Set oRng = Nothing
  Exit Sub
End Sub