Do until end of doc

[zach]

I am new to vba and not sure how to force a macro to run until the end of a
document. What I am trying to do is find a certain word and copy something
that is always located 11 rows above and paste to another document. I need
it to run till the end of the file. I know that I need a do ...loop of some
kind and tried but it doesn't want to exit the loop that I came up with.
Here is what I have any suggestions are much appreciated...


Sub Find and copy()

Selection.Find.ClearFormatting
With Selection.Find
.Text = "ON ACCT"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute

If Selection.Find.Found = True Then
Selection.MoveUp Unit:=wdLine, Count:=11
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Copy
Windows("ON ACCT.doc").Activate
Selection.Paste
Windows("C062705.doc").Activate
Selection.MoveDown Unit:=wdLine, Count:=12
Else

End If

End Sub

Thanks Zach

 

[Helmut Weber]

Hi Zach,

searching in the selection and moving the selection around,
is not a good idea. You would have to make sure, that after
changing the selection and moving back to the replacement
position the selection is newly defined as from the last
replacement til the end of doc.

Or you define a range, search in the range, then move the
selection, whereby the range stays untouched, in principle.

Untested for lack of testing material:

Sub FindCopy() ' no blanks in the name !
dim rDcm as range
set rDcm = activedocument.range
With rdcm.Find
.Text = "ON ACCT"
.Wrap = wdFindstop ' !!!
while .execute
rdcm.select
Selection.MoveUp Unit:=wdLine, Count:=11
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Copy
Windows("ON ACCT.doc").Activate
Selection.Paste
Windows("C062705.doc").Activate
Selection.MoveDown Unit:=wdLine, Count:=12
' Maybe you have to define the range anew here, like
' rdcm.start = selection.start
' rdcm.end = activedocument.range.end
wend
End With
end Sub


Greetings from Bavaria, Germany

Helmut Weber, MVP, WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"