Hi Anthony,

Here's some code that does what you want, I believe. You will have to
change the worksheet name to match yours.

However, I cannot figure out the error handling in case there is no number
entered in the Input box or a number that does not exist.

I'll post the code to the group and see if I can get the error handling
fixed and get back to you.

Sub TransferIt()
Dim i As Long
Dim Rng As Range
Dim c As Range
Dim j As Long

i = Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range("A2:A" & i)
j = InputBox("Please enter the job" & vbCr & _
"number you wish to" & vbCr & "print a job card for")

For Each c In Rng
If c.Value = j Then
c.Resize(1, 7).Copy Sheets("Sheet2"). _
Range("G100").End(xlUp).Offset(1, 0)
End If
Next
End Sub

HTH
Regards,
Howard

"Anthony" wrote in message
...
Hi,
I have the following code (donated) which will take a number input by the
user and then seach a whole column for that corresponding number. Once
found
it will then copy/paste the whole of that rows data onto another
worksheet.
This works fine as there is never the same number in the column twice,
what
I now need is for the column to be searched and then each time the same
number is found to copy each rows data onto a seperate sheet until all the
'input number' corresponding rows data has been pasted onto seperate rows
in
a new worksheet.

For example, if the number input by the user is 12345 . The seach is made
and its found that this number is shown in cells A3, A7, A10 I want all
the
data in cells A3:G3, A7:G7, and A10:G10 to be pasted into seperate rows in
another worksheet.
hope that makes sense, and here is the code I have....

Sub print_mon_jobcard()
Dim i As Integer
Dim iRow As Integer
Dim Cel As Range
Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet
Dim lLastRow As Long
'On Error GoTo err_handler
Set wks1 = ThisWorkbook.Worksheets("monday's log")
Set wks2 = ThisWorkbook.Worksheets("formula")
Set wks3 = ThisWorkbook.Worksheets("jobcard")
i = InputBox("Please enter the job number you wish to print a job card
for")

On Error Resume Next
Set Cel = wks1.Columns("B:B").Find _
(What:=i, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Cel Is Nothing Then
MsgBox "No job with the number " & i & _
" has been found, please try again! "
Exit Sub
End If
On Error GoTo err_handler
iRow = Cel.Row
wks1.Cells(iRow, 1).EntireRow.Copy Destination _
:=wks2.Cells(2, 1)

wks3.PrintOut
Exit Sub

err_handler:
MsgBox Error, , "Err " & Err.Number
End Sub