Search a worksheet, find matches, copy row data to another worksheet

[sarasotavince]

Hello All. Trying to get some help with this problem. I have two worksheets (LABOR) and (SEARCH). From a userform I call an input box and ask for the search criteria. I then search column A on the LABOR worksheet for all matches --and want to copy each row's data of the LABOR worksheet to the SEARCH worksheet. I am using the following code, which does not produce an error but it does not produce any results either. After the search criteria is entered I see the message box telling me the operation is complete. I have tinkered with this code but obviously I am missing something. I may also have "more" code than I need so if something can be deleted please REM it out....thanks in advance. Here is the non-working code:

Private Sub CommandButton4_Click()
Dim strLastRow As String
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim wSht As Worksheet
Dim rngtest As String
Application.ScreenUpdating = False
Set wSht = Worksheets("Labor")
strToFind = InputBox("Enter Search Criteria")
With wSht.Range("A:A")
Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
Do
strLastRow = Sheets("Search").Range("A" & Rows.Count).End(xlUp).Row + 1
rngC.EntireRow.Copy .Cells(strLastRow, 1)
Set rngC = .FindNext(rngC)
Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
End If
End With
MsgBox ("Finished")
End Sub

 

[John_w]

The .Cells in this line:

rngC.EntireRow.Copy .Cells(strLastRow, 1)

refers to the wrong sheet (With wSht.Range("A:A")).

Try:

rngC.EntireRow.Copy Sheets("Search").Cells(strLastRow, 1)

 

[sarasotavince]

Try I did and it works perfectly! That one simple change made all the difference. So, here is the working code.

Thanks to John_w.

Private Sub CommandButton1_Click()
Dim strLastRow As String
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim wSht As Worksheet
Dim rngtest As String
Application.ScreenUpdating = False
Set wSht = Worksheets("Labor")
strToFind = InputBox("Enter Search Criteria")
With wSht.Range("A:A")
Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
Do
strLastRow = Sheets("Search").Range("A" & Rows.Count).End(xlUp).Row + 1
rngC.EntireRow.Copy Sheets("Search").Cells(strLastRow, 1)
Set rngC = .FindNext(rngC)
Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
End If
End With
MsgBox ("Finished")
 
End Sub

Hope this can save someone a few hours sleep. Thanks again.