Change code to search amount.

[abjac]

HI I have below code which search in column J for the amount. and when find it copy the rows to sheet 3, which have this amount.
I need 2 changes.
First i need to when i search and it copy to sheet 3. If i search again for other amount. i need it to not overwrite the all ready found rows but continue in the next blank row
in sheet 3.

The next i need is a change in the amount of rows. Its like this code can only work with the 65536 rows even if the workbook is saved as a xlsm in excel 2013.
I need the range to be made so it can search in big sheets. This line i need to be changed

#lastline = Range("A65536").End(xlUp).Row#




Here is the full code. Please have a look.

Sincerely

Abjac

P.s i cant put anything around the code. Like the option is not there i tried put manually in, but its not working the option to make bold and the other is not there now.

#Sub customcopy()
Sheets(2).Activate
Dim strsearch As String, lastline As Integer, tocopy As Integer
linestart:
strsearch = CStr(InputBox("enter the amount to search for"))
lastline = Range("A65536").End(xlUp).Row
j = 2
For i = 1 To lastline
' Can search in more than one column. Change the range example A instead of J and second J,
' will search in column A to J then below example only in column J
For Each c In Range("J" & i & ":J" & i)
If InStr(c.Text, strsearch) Then
tocopy = 1
End If
Next c
If tocopy = 1 Then
Rows(i).Copy Destination:=Sheets(3).Rows(j)
j = j + 1
ffound = ffound + 1
End If

tocopy = 0

Next i
If ffound = 0 Then
MsgBox "Not found, Try again"
GoTo linestart
End If
End Sub#