Copying Paragraphs to a new document

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Malik Al-Amin - 13 Dec 2004 17:49 GMT

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

Reply to this Message

Charles Kenyon - 13 Dec 2004 18:19 GMT

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

Signature

Charles Kenyon

Word New User FAQ & Web Directory: http://addbalance.com/word

Intermediate User's Guide to Microsoft Word (supplemented version of
Microsoft's Legal Users' Guide) http://addbalance.com/usersguide

See also the MVP FAQ: http://www.mvps.org/word which is awesome!
--------- --------- --------- --------- --------- ---------
This message is posted to a newsgroup. Please post replies
and questions to the newsgroup so that others can learn
from my ignorance and your wisdom.

>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
[quoted text clipped - 11 lines]
>
> Malik

Reply to this Message

Helmut Weber - 13 Dec 2004 18:20 GMT

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/

Reply to this Message

Peter - 13 Dec 2004 18:29 GMT

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:úlse)
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

> 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
[quoted text clipped - 7 lines]
>
> Malik

Reply to this Message

Rate this thread: