Copying Paragraphs to a new document

[Malik Al-Amin]

I want to open up a word document and loop through all of the paragraphs in
the document. For every paragraph that starts with "cpy" I want to copy that
paragraph to a 2nd document and then move to the next paragraph and continue
the process until I have all of the paragraphs beginning with cpy. A friend
was trying to do this but every time he copied a new paragraph it overwrote
the previous paragraph so he ended up with a second document with just one
paragraph.

Thanks

Malik

 

[Charles Kenyon]

If you post the code that isn't working, someone will probably be able to
tweak it for you.

 

[Helmut Weber]

Hi Malik,

have a look at this one and ask again, if necessary.
I think, there is no use in explaining all, that could
posssibly be unclear, beforehand.

Sub Makro2()
Dim oDcm1 As Document ' source
Dim oDcm2 As Document ' target
Set oDcm1 = Documents("Source.doc")
Set oDcm2 = Documents("Target.doc")
Dim rtmp As Range
Set rtmp = oDcm1.Range
ResetSearch
With rtmp.Find
.Text = "cpy"
While .Execute
If Left(rtmp.Paragraphs(1).Range.Text, 3) = "cpy" Then
oDcm2.Range.InsertAfter rtmp.Paragraphs(1).Range.Text
End If
Wend
End With
ResetSearch
End Sub
Public Sub ResetSearch()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub

Greetings from Bavaria, Germany
Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Peter]

The key to not overwriting when you copy is to use Document.Range.InsertAfter.

Something like the following is probably what you want to do:

Dim Doc1 As Document
Dim Doc2 As Document
Dim para As Paragraph

Set Doc1 = Application.Documents.Open(FileName:="doc1.doc", Visible:=False)
Set Doc2 = Application.Documents.Add

For Each para In Doc1.Paragraphs
With para.Range
If Left(.Text, 3) = "cpy" Then
Doc2.Range.InsertAfter .FormattedText
End If
End With
Next para

Call Doc1.Close(False)
Call Doc2.Activate

Set Doc1 = Nothing

hth,

-Peter