MS Word VBA to Remove Extra Blank Lines

I have a report in MS Access which I export as RTF. Because of templates etc I thencopy the rtf file and paste it into a template. For some reason I'm getting a bunch of extra blank lines when I do that which creates an extra section break which creates a messed up document. I've found this code to remove extra blank lines but it takes at least 10 minutes per document. Do you have better ideas?

Topic: VBA Examples (Microsoft Word)

suggestions for improvement?



Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p^p"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
While Selection.Find.Found
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeBackspace
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.Find.Execute
Wend