Select all cells matching my find criteria - vba

Question

I´m writing a simple macro for searching my value in table. I know that searched value is in the document many times. But my macro finds just first value in table. I want select all rows with the value I´m looking for. Then I want copy selected rows and copy them to "sheet2". Can somebody help me adjust my macro? Thx
Sub Vyhladat()
Sheets("Sheet1").Columns(24).Find(What:=InputBox("Please enter your LR number", "Search")).Select
ActiveCells.EntireRow.Select
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
Do
If IsEmpty(ActiveCell.Value) Then
ActiveCell.PasteSpecial xlPasteValues
End
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub

Answer 1

Here is how to do it (find the first match and then loop with the FindNext() method) :
Sub test_Jean()
Dim FirstAddress As String, _
cF As Range, _
RowsToCopy As String
ActiveSheet.Cells(1, 24).Activate
With ActiveSheet.Columns(24)
'First, define properly the Find method
Set cF = .Find(What:=InputBox("Please enter your LR number", "Search"), _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
'If there is a result, keep looking with FindNext method
If Not cF Is Nothing Then
FirstAddress = cF.Address
Do
cF.EntireRow.Copy
Sheets("Sheet2").Range("A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
Set cF = .FindNext(cF)
'Look until you find again the first result
Loop While Not cF Is Nothing And cF.Address <> FirstAddress
End If
End With
End Sub