A slight mod of the example for FIND in vba. Should be quicker and easier

Sub findcopy()
With Sheets("sheet12").Range("a1:a500")
Set c = .Find(2, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
x = Sheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Row + 1
c.EntireRow.Copy Sheets("sheet2").Cells(x, "a")
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstaddress
End If
End With
End Sub

--
Don Guillett
SalesAid Software

"Gordon C" wrote in message
...
...so far.

I have a spreadsheet 5000 deep and 90 across. I need the
code below to launch an input box so that when I enter a
value into this box I want any row on which the value
occours to be cut and pasted into a new sheet, all the
while cells/rows on the original sheet are moved upwards.

I'm almost there but I'm left scratching my head.

Any help would be appreciated...

Public Sub transfer()
Worksheets("Sheet1").Activate
Dim lastrow As Long
Dim lastcol As Long
Dim sString As String
sString = InputBox("ENTER YOUR VALUE: ANY ROW ON
WHICH THIS VALUE IS FOUND WILL BE COPIED TO A NEW SHEET")
If sString = "" Then
MsgBox "No search criteria requested.", vbOKOnly +
vbInformation, "Cancel is pressed."
Exit Sub
End If

lastrow = ActiveSheet.UsedRange.Rows.Count
lastcol = ActiveSheet.UsedRange.Columns.Count
Application.ScreenUpdating = False
Dim ir As Long, ic As Long, rd As Long
For ir = lastrow To 1 Step -1
For ic = lastcol To 1 Step -1
Cells(ir, ic).Activate
If UCase(Cells(ir, ic).Value) = UCase(sString) Then
Rows(ir).Copy Destination:=Sheets
(yournewsheet).Range("A1").End(xlDown).Offset(1, 0)
Rows(ir).Delete Shift:=xlUp
ir = ir - 1
ic = lastcol + 1
rd = rd + 1
End If
Next ic
Next ir
Application.ScreenUpdating = True
MsgBox "You have deleted: " & rd & " rows"
End Sub

Cheers

Gordon.