Thanks Jason. The document on worksheet one is a report and all data is held
in the first column, I think this means that the "Option Explicit" part does
not work. The idea is to search for the common identifier in that cell, copy
the whole cell across and then text to column on worksheet 2 once the loop
macro has run. Does that make sense?

"Jason Lepack" wrote:

Make a backup of your spreadsheet and in the backup test this code:

' - START OF CODE -
Option Explicit

Private Function lookForNext(s As String, r As Range, ws As Worksheet)
As Range
Set lookForNext = ws.Cells.Find(What:=s, After:=r,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, _
MatchCase:=False)
End Function

Public Sub DoUntilJohnP()

On Error GoTo DOUJP_ERR

Dim wb As Workbook
Dim wsOld As Worksheet, wsNew As Worksheet
Dim rOld As Range, rNew As Range

Set wb = ActiveWorkbook
Set wsOld = wb.ActiveSheet
Set wsNew = wb.Sheets("Sheet2")

Set rOld = wsOld.Range("A1")
Set rOld = lookForNext("ele nonrec", rOld, wsOld)
Set rNew = wsNew.Range("A1")
If Not rOld Is Nothing Then
Do Until InStr(1, rOld.Formula, "ele nonrec END") 0

rOld.Copy
Set rNew = rNew.Offset(1, 0)
rNew.PasteSpecial xlPasteAll

Set rOld = lookForNext("record sent", rOld, wsOld)
rOld.Copy
rNew.Offset(0, 8).PasteSpecial xlPasteAll

Set rOld = lookForNext("global", rOld, wsOld)
rOld.Copy
rNew.Offset(0, 23).PasteSpecial xlPasteAll

Set rOld = lookForNext("o", rOld, wsOld)
rOld.Copy
rNew.Offset(0, 29).PasteSpecial xlPasteAll

Set rOld = lookForNext("ele nonrec", rOld, wsOld)
Loop
Else
MsgBox "'ele nonrec' was not found in formulas of spreadsheet"
End If
DOUJP_GOODBYE:
Set rOld = Nothing
Set rNew = Nothing
Set wsOld = Nothing
Set wsNew = Nothing
Set wb = Nothing
Exit Sub
DOUJP_ERR:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "DESCRIPTION:" & vbCrLf
& Err.Description
Resume DOUJP_GOODBYE
End Sub
' - END OF CODE -

On Feb 22, 8:07 am, JohnP wrote:
Hi,

I need the following to code to loop, but each time pasting one row further
down on Sheet 2 until the Control Find function finds "Ele NonRec END".

Cells.Find(What:="ele nonrec", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Cells.Find(What:="record sent", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("I2").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Cells.Find(What:="global", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("X2").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Cells.Find(What:="o", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False) _
.Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("AD2").Select
ActiveSheet.Paste
Sheets("Sheet1").Select

Please help!! Thank you in advance.

John