Excel macro to find a cell in a sheet and copy the entire row in another sheet

Question

I have a excel sheet with around 50k rows and i need a macro to search for a cell in that sheet and if it finds it to copy the entire row to another sheet, my problem is that the keyword may be on multiple rows so if there are like 4 cells with that keyword i need it to copy all 4 rows and paste them in another sheet

Sub saca()

Dim intPasteRow As Integer
intPasteRow = 2
Dim ceva As Range
Dim FirstAddress As String
Dim intRow As Integer

Sheets("Sheet2").Select
Columns("A:AV").Select
On Error Resume Next
Set ceva = Selection.Find(What:="m762", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=True).Activate
If Not ceva Is Nothing Then
    FirstAddress = ceva.Address
    Do
        Set ceva = Selection.FindNext(ceva).Activate
    Loop While Not ceva Is Nothing And ceva.Address <> FirstAddress
End If

intRow = ActiveCell.Row
Rows(intRow & ":" & intRow).Select
Selection.Copy

Sheets("Sheet1").Select
ActiveSheet.Paste

End Sub

So far its searching for "m762" in Sheet2 but it only copies the first row with a "m762" cell instead of selecting all of them...I can't find a way to make it select all rows with "m762" in them

Answer 1

Although not the best or quickest solution, here is a basic For Loop macro that will loop through each cell and when the criteria is found, it will copy the row in Sheet2 to the next empty row in Sheet1 by setting the values directly from Sheet2 to Sheet1 . It will then continue and copy each row where the criteria is found.

Dim cel As Range, lRow As Long

    For Each cel In ThisWorkbook.Sheets("Sheet2").Range("A2:AV" & Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row)
        If cel.Value = "m762" Then
            lRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

            ThisWorkbook.Sheets("Sheet1").Cells(lRow + 1, 1).Resize(, 48).Value = ThisWorkbook.Sheets("Sheet2").Cells(cel.Row, 1).Resize(, 48).Value
        End If
    Next cel