hi all
My 1st attempt at vba and i am stuck
I have approx 60000 rows to process
As you can see program find the word material and then copies and paste
various cell onto sheet two, when it reads the cell content to be 9998 it
jump out of the loop.This work brillantly but I need it to now look for the
second occurance of the word material and process that position. then fourth
occurances ect untill all occurance of the word material has been
done.thanks in advance for any help

Sub Find_First()


Dim FindString As String
Dim Rng As Range
Sheets("Sheet1").Select
FindString = ("MATERIAL")
If Trim(FindString) < "" Then
Set Rng = Range("A:A").Find(What:=FindString, _
After:=Range("A" & Rows.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then Application.Goto Rng, True
End If
Application.ScreenUpdating = False
'Sheets("Sheet1").Select
'Range("b8").Select
ActiveCell.Activate
ActiveCell.Offset(rowOffset:=0, columnOffset:=2).Activate
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("f" & finalrow + 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=2, columnOffset:=0).Activate
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("g" & finalrow + 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=0, columnOffset:=8).Activate
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("h" & finalrow + 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=5, columnOffset:=-6).Activate
Do Until n = 80
If Selection.Value = ("9998") Then n = 80
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("A" & finalrow + 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=0, columnOffset:=5).Activate
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("B" & finalrow + 0).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=3, columnOffset:=0).Activate
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("C" & finalrow + 0).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("D" & finalrow + 0).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=-4, columnOffset:=2).Activate
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("E" & finalrow + 0).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=5, columnOffset:=-7).Activate
ActiveCell.Select
Loop
Application.ScreenUpdating = True
Sheets("Sheet2").Select

End Sub