Excel VBA, compare values in two ddifferent columns and keep entire line for common values

Question

I have two worksheets with information and I want to compare values in a column from each worksheet and if the values are the same, then I want to copy that entire line that corresponds to a new worksheet. I currently am using For Next loops but it is very time consuming to run. Does anyone know a faster method for accomplishing this same task?

'compares results and copies entire row with like results to new page
Sheets(2).Select
LR2 = 0
LR2 = Cells(Rows.Count, 1).End(xlUp).Row
Sheets(3).Select
LR3 = 0
LR3 = Cells(Rows.Count, 1).End(xlUp).Row
Sheets(2).Select
x = 2
For I = 2 To LR2
CellVal = Cells(x,3).Value
    Sheets(3).Select
    xx = 2
    For ii = 2 To LR3
        CellVal2 = Cells(xx,3).Value
        If CellVal = CellVal2 Then
            Rows(xx).Copy
            Sheets(1).Select
            LR1 = 0
            LR1 = Cells(Rows.Count, 1),End(xlUp).Row
            Cells(LR1 + 1, 1).Select
            Selection.PasteSpecial Paste:=xlPasteValues
            Selection.NumberFormat = "0"
            Selection.Columns.AutoFit
        End If
    xx = xx + 1
    Next ii
x = x + 1
Next i

Answer 1

I think you could modify & use the below:

Option Explicit

Sub test()

    Dim Lastrow1 As Long, Lastrow2 As Long, Lastrow3 As Long, i As Long
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim str As String
    Dim rng As Range

    'Set Worksheet' Variables
    With ThisWorkbook
        Set ws1 = .Worksheets("Sheet1")
        Set ws2 = .Worksheets("Sheet2")
        Set ws3 = .Worksheets("Sheet3")
    End With

    'Clear Sheet3
    ws3.UsedRange.Clear

    'Find Lastrow of Sheet1 & Sheet2
    Lastrow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    Lastrow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

    'Loop Sheet1, Column A
    For i = 1 To Lastrow1

        'Set str. It's the value in Sheet1, Column A & Row i
        str = ws1.Range("A" & i).Value

        'Use Find Method to check if str apperas in Sheet2, Column A
        Set rng = ws2.Range("A1:A" & Lastrow2).Find(str)

        'If rng in not nothing - Empty (means that str found in sheet2, column A
        If Not rng Is Nothing Then
            'Find lastrow of Sheet3, Column A
            Lastrow3 = ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row
            'Copy from Sheet1, Column A & row rng.row to Sheet3, Column A Lastrow3 + 1
            ws1.Cells(rng.Row, 1).Copy ws3.Cells(Lastrow3 + 1, 1)
        End If

    Next i

End Sub