Hi All,

I'm a big time Newbie.

I have had a look into DO LOOP but I must say I'm a bit lost.

I would like to loop the following untill end of file.

Please Help

Sub Sheet_2()
'Find copy and move to new cell.
'
Cells.Find(What:="define", After:=ActiveCell, LookIn:=xlFormulas,
LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
'
Selection.Copy
ActiveCell.Offset(0, 2).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End Sub


Thanks

Wombatz


---
Message posted from http://www.ExcelForum.com/

I'm not sure what you want (as far as copying and
pasting), but this is a Do Loop that might help you. This
is one of my earlier methods of programming when I started
doing Excel VBA many years ago. It reminds me of Fortran
IV programming that I studied - that's why I started out
this way.

Sub DoLoop()
Dim X As Integer
X = 0

Do Until X 100
X = X + 1
ActiveCell.Offset(1, 0).Select
If ActiveCell.Offset(0, 0).Value = "Hi" Then
GoTo MessageFoundIt
End If
Loop

Exit Sub
MessageFoundIt:
MsgBox "You found Hi at row number " & _
ActiveCell.Offset(0, 0).Row & ".", _
vbInformation, "Found It"
End Sub

-----Original Message-----
Hi All,

I'm a big time Newbie.

I have had a look into DO LOOP but I must say I'm a bit
lost.

I would like to loop the following untill end of file.

Please Help

Sub Sheet_2()
'Find copy and move to new cell.
'
Cells.Find(What:="define", After:=ActiveCell,
LookIn:=xlFormulas,
LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
'
Selection.Copy
ActiveCell.Offset(0, 2).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End Sub


Thanks

Wombatz


---
Message posted from http://www.ExcelForum.com/

.

Hi Rick,

I'm ok with the copy and past part.

The word DEFINE in the Cells.Find(What:= is all the way through th
file. this file is very big and all i need to do is copy what is in th
DEFINE cell to a new cell.
i need the loop to search the file until it's comes to end of file an
stop

eg:

DEFINE RECORD CUSTOMER 784
data (this data could be anything from numbers to statments)
data
DEFINE RECORD CUSTOMER 187
data
data
DEFINE RECORD CUSTOMER 234

Thank

--
Message posted from http://www.ExcelForum.com

Wombatz

Assuming that the "define" is always in column A, then the following should get you going. It will put the contents of the cell containing the word "define" 2 cells to the right.

Sub bbb()
With Columns("a:a")
Set c = .Find("define")
If Not c Is Nothing Then
firstaddr = c.Address
Range(c.Address).Offset(0, 2).Value = c.Value
Set c = .FindNext(c)
While Not c Is Nothing And c.Address < firstaddr
Range(c.Address).Offset(0, 2).Value = c.Value
Set c = .FindNext(c)
Wend
End If
End With
End Sub

Tony

Thanks Tony,

this is good.

could you help with one more thing.
i need to copy the define statment into the next 8 cells below

Thanks

Wombat

--
Message posted from http://www.ExcelForum.com

Wombatz

Try this.

Tony

Sub bbb()
With Columns("a:a")
Set c = .Find("define")
If Not c Is Nothing Then
firstaddr = c.Address
For i = 0 To 7
Range(c.Address).Offset(i, 2).Value = c.Value
Next i
Set c = .FindNext(c)
While Not c Is Nothing And c.Address < firstaddr
For i = 0 To 7
Range(c.Address).Offset(i, 2).Value = c.Value
Next i
Set c = .FindNext(c)
Wend
End If
End With
End Sub