Hi...

The code below launches an input box then deletes any row
in which the value entered into the input box is found. I
can't work out how I edit this code so the value entered
into the input box will copy all rows of its occourance
into a new worksheet within the workbook rather than
delete it.

Any help would be appreciated.

Public Sub remove()
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 DELETED")
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).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

Thanks

Hi,
Try adding a line of code just before the delete line
Rows(ir).copy destination:= sheets(your new
sheet).Range("A1").end(xldown).offset(1,0)

-----Original Message-----
Hi...

The code below launches an input box then deletes any row
in which the value entered into the input box is found. I
can't work out how I edit this code so the value entered
into the input box will copy all rows of its occourance
into a new worksheet within the workbook rather than
delete it.

Any help would be appreciated.

Public Sub remove()
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 DELETED")
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).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

Thanks
.