Word VBA １行づつ余計な改行が入っている場合に1行だけ改行させるマクロ

Word ：空白行を一括削除するには
http://office-qa.com/Word/wd394.htm

というのをいつも使っていつも忘れるのでVBA化しました。
なんのことだかわからない人は紹介したサイトを見てください。
しかし

※空白行は前の段落から数えて段落記号が2個以上あるからです。
※13で置換するとレイアウトが崩れるため^pを指定します。

このあたり本当にどこに書いてあるんだ。。。
しかも改行と自分が言っているのは本当は段落記号らしい。
ちなみに元サイトは2つ以上の連続ですが、こちらは1つだけにしています。

Sub WordTwoLinesOnelineJpn()
' For Word 2007 Later
' 日本語用 For Japanese
With Selection
.EndKey Unit:=wdStory 'いったん文末に飛ばし、文頭に飛ばす
.HomeKey Unit:=wdStory
.Find.ClearFormatting '段落書式指定をクリア
.Find.Replacement.ClearFormatting 'Removes text and paragraph formatting from the text specified in a replace operation.
.Find.ClearAllFuzzyOptions 'Clears all nonspecific search options associated with Japanese text.
.Find.ClearHitHighlight
With .Find
.Text = "^13^13"
.Replacement.Text = "^p"
.Forward = True
.LanguageIDFarEast = wdJapanese '日本語以外では設定を変えるか省略する
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
'.Execute2007 'Selection.Find.Execute2007(FindText, MatchCase, MatchWholeWord, MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward, Wrap, Format, ReplaceWith, Replace, MatchKashida, MatchDiacritics, MatchAlefHamza, MatchControl, MatchPrefix, MatchSuffix, MatchPhrase, IgnoreSpace, IgnorePunct)
.Execute Replace:=wdReplaceAll 'ここを外さない 'Selection.Find.Execute (FindText, MatchCase, MatchWholeWord, MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward, Wrap, Format, ReplaceWith, Replace, MatchKashida, MatchDiacritics, MatchAlefHamza, MatchControl)
End With
End With
End Sub