The following would leave one empty paragraph between paragraphs, but it would be far better to remove all empty paragraphs and apply styles to give the spacing you require. See also
Replace using wildcards
Code:
Sub Macro1()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^13{2,}"
.Replacement.Text = "^p^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End Sub