Macro to replicate every paragraph in a document

[mpeterson]

Hi Guys,

I have a word document of over 500 paragraphs each separated with an extra newline. I need to replicate each paragraph to be under its original copy as follows:
Original paragraph 1

Original paragraph 2
.
.
.

to be:
Original paragraph 1
Original paragraph 1

Original paragraph 2
Original paragraph 2
.
.

Can someone help with this request please?
many thanks..

[gmayor]

If the 'extra new2 line' is an empty paragraph then


Sub Replicate()
Dim oRng As Range
Dim i As Long
For i = ActiveDocument.Paragraphs.Count To 1 Step -1
Set oRng = ActiveDocument.Paragraphs(i).Range
If Len(oRng) > 1 Then
oRng.InsertAfter oRng
End If
Next i
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

or if there is formatting you wish to retain


Sub Replicate()
Dim oRng As Range
Dim i As Long
For i = ActiveDocument.Paragraphs.Count To 1 Step -1
Set oRng = ActiveDocument.Paragraphs(i).Range
If Len(oRng) > 1 Then
oRng.Copy
oRng.Collapse 0
oRng.Paste
End If
Next i
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

[mpeterson]

Fabulous Graham, your script ran like magic, as usual :)
I do thank you for your knowledge, effort and time spent on such masterpiece.
My best regards.