Find, Cut, then Paste Methodology

[Raul]

I have a number of documents that have questions in one part of a document
and the corresponding answers in another part of the document. I need to
modify the document to have the answer four lines after the associated
question.

I need to be able to:
1) loop through the document,
2) find "question 1",
3) go down 4 lines and mark that location as the place to paste "answer 1",
4) then find "answer 1",
5) cut "answer 1" and paste in the new location for "answer 1".
6) loop to the next question number.

Can anyone help me get started?

Thanks in advance,
Raul

 

[Chuck]

Try this:

Sub FindQandA()

Dim i As Long
Dim rngSource As Range
Dim rngTarget As Range
Dim docSource As Document
Dim docTarget As Document

i = 0
strQText = "Question " & CStr(i)

Set docSource = ActiveDocument
Set docTarget = Documents.Add

Do
Set rngSource = docSource.Range
i = i + 1
With rngSource.Find
.Text = "Question " & CStr(i)
If .Execute Then
With rngSource
.Expand wdParagraph
Set rngTarget = docTarget.Range
rngTarget.Collapse wdCollapseEnd
rngTarget.Text = rngSource.Text & _
vbNewLine & _
vbNewLine & _
vbNewLine & _
vbNewLine
Set rngSource = docSource.Range
With rngSource.Find
.Text = "Answer " & CStr(i)
.Execute
With rngSource
.Expand wdParagraph
Set rngTarget = docTarget.Range
rngTarget.Collapse wdCollapseEnd
rngTarget.Text = rngSource.Text & _
vbNewLine & _
vbNewLine & _
vbNewLine & _
vbNewLine
End With
End With
End With
Else
Exit Do
End If
End With
Loop

Set docSource = Nothing
Set docTarget = Nothing

End Sub

 

[Raul]

This is really great.

Thanks,
Raul

Try this:

Sub FindQandA()

Dim i As Long
Dim rngSource As Range
Dim rngTarget As Range
Dim docSource As Document
Dim docTarget As Document

i = 0
strQText = "Question " & CStr(i)

Set docSource = ActiveDocument
Set docTarget = Documents.Add

Do
Set rngSource = docSource.Range
i = i + 1
With rngSource.Find
.Text = "Question " & CStr(i)
If .Execute Then
With rngSource
.Expand wdParagraph
Set rngTarget = docTarget.Range
rngTarget.Collapse wdCollapseEnd
rngTarget.Text = rngSource.Text & _
vbNewLine & _
vbNewLine & _
vbNewLine & _
vbNewLine
Set rngSource = docSource.Range
With rngSource.Find
.Text = "Answer " & CStr(i)
.Execute
With rngSource
.Expand wdParagraph
Set rngTarget = docTarget.Range
rngTarget.Collapse wdCollapseEnd
rngTarget.Text = rngSource.Text & _
vbNewLine & _
vbNewLine & _
vbNewLine & _
vbNewLine
End With
End With
End With
Else
Exit Do
End If
End With
Loop

Set docSource = Nothing
Set docTarget = Nothing

End Sub

 

[Raul]

This procedure worked beautifully.

Not to be too greedy, but Is there a way to modify this code to select the
paragraph that starts with Answer 1 as well as the following four paragraphs?

Thanks,
Raul

 

[Chuck]

BTW that line strQTest =... isn't necessary, it's left over from something
else.

 

[Chuck]

Instead of .Expand you can also use .MoveEnd to extend the range. .MoveEnd
takes two arguments, the kind of move (character, paragraph, etc) and the
count (1, 2, 3 etc):

Sub FindQandA()

Dim i As Long
Dim rngSource As Range
Dim rngTarget As Range
Dim docSource As Document
Dim docTarget As Document

i = 0
strQText = "Question " & CStr(i)

Set docSource = ActiveDocument
Set docTarget = Documents.Add

Do
Set rngSource = docSource.Range
i = i + 1
With rngSource.Find
.Text = "Question " & CStr(i)
If .Execute Then
With rngSource
.MoveEnd wdParagraph, 1
Set rngTarget = docTarget.Range
rngTarget.Collapse wdCollapseEnd
rngTarget.Text = rngSource.Text & _
vbNewLine & _
vbNewLine & _
vbNewLine & _
vbNewLine
Set rngSource = docSource.Range
With rngSource.Find
.Text = "Answer " & CStr(i)
.Execute
With rngSource
.MoveEnd wdParagraph, 4
Set rngTarget = docTarget.Range
rngTarget.Collapse wdCollapseEnd
rngTarget.Text = rngSource.Text & _
vbNewLine & _
vbNewLine & _
vbNewLine & _
vbNewLine
End With
End With
End With
Else
Exit Do
End If
End With
Loop

Set docSource = Nothing
Set docTarget = Nothing

End Sub

 

[Raul]

Chuck,
This worked like a charm; .MoveEnd did the trick.
I realy appreciate your writing this for me.

Thanks again,
Raul