My first post to this site. Unfortunately I've already posted this same query @ Mr. Excel's site but it seems more likely that a post here would produce some results. From XL, I am trying to find a keyword in a summary document then copy the paragraph containing the keyword to another document. The number of paragraphs to be copied is variable. The code below finds the keyword "seed" in "summary.doc" (once only) and copies it to "test.doc". This is a start. If anyone is able to help with the how to's of copying all of the whole paragraphs containing "seed" in the summary document to the test document, I sure would appreciate it. Thanks. Dave


Private Sub CommandButton1_Click()
Dim Wdapp As Object, Wdapp2 As Object
Dim MyData As DataObject, Bigstring As String
'finds and extracts paragraphs from summary.doc to test.doc
'identifies paragraphs by key word in 1st line
'copies paragraph to clipboard then transfer to test.doc
'variable # of paragraphs to copy/transfer
On Error GoTo Evlmsg1
Set Wdapp = CreateObject("Word.application")
    Wdapp.ChangeFileOpenDirectory "c:\records\"
    Wdapp.documents.Open Filename:="summary.doc"
    With Wdapp.activedocument
     .Range(0, .Characters.Count).Select
    End With
 'keyword "seed" eg
 With Wdapp.Selection.Find
    .ClearFormatting
    .Execute FindText:="seed", Format:=False, Forward:=True
    '***line below errors
    '.Expand Unit:=wdParagraph
 End With
With Wdapp.Selection
.Range.Copy
End With
Wdapp.activedocument.Close savechanges:=True
Returntocode:
On Error GoTo 0
Wdapp.Quit
Set Wdapp = Nothing
Set MyData = New DataObject
    MyData.GetFromClipboard
    Bigstring = MyData.GetText(1)
On Error GoTo Evlmsg2
Set Wdapp2 = CreateObject("Word.Application")
    Wdapp2.ChangeFileOpenDirectory "c:\"
    Wdapp2.documents.Open Filename:="test.doc"
'use to initial clear test.doc
    With Wdapp2.activedocument
    .Range(0, .Characters.Count).Delete
    End With
With Wdapp2.activedocument
    .content.insertafter Bigstring
    End With
Wdapp2.activedocument.Close savechanges:=True
Wdapp2.Quit
Set Wdapp2 = Nothing
Exit Sub
Evlmsg1:
MsgBox "error1"
GoTo Returntocode
Evlmsg2:
On Error GoTo 0
Wdapp2.Quit
Set Wdapp2 = Nothing
MsgBox "Error2"
End Sub