Comparing two columns in two different sheets to find duplicate

I have been trying to work on this all day and I am getting now where. Any help would be greatly appreciated.

Basically I have data in two different sheets and would like to find the duplicates in sheet 1 and sheet 2, both column A. Sheet 1 has data that will change month to month while sheet 2's data will be constant. I would like to compare sheet 2, column A to sheet 1, column A and if there is a match, then pull the matching data from sheet 1 to sheet 3. (There will be multiple data on sheet 1, that will have the same number from sheet 2)

It would be great if I could get this to be automated, so that I can just drop in the data for sheet 1 each month and have it do it all.

I have included a sample sheet.

Any help would be amazing

Thanks

Hope this help

PHP Code: 

Option Explicit
Sub Comparing()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
 Dim MyAdd As String, jJ As Byte
 
 Sheet2.Select
 Set Sh = ThisWorkbook.Worksheets("Sheet1")
 Set Rng = Sh.Range(Sh.[A1], Sh.[A1].End(xlDown))
 For Each Cls In Range([A1], [A1].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address:                   jJ = 0
        Do
            sRng.Resize(, 5).Copy Destination:=Sheet3.Cells(65535, "A").End(xlUp).Offset(1)
            Cls.Interior.ColorIndex = 34:           jJ = jJ + 1
            sRng.Interior.ColorIndex = 34 + jJ
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 Next Cls
End Sub 


TO davesexcel;2764438

Time(For. . . .Next) >> Time(FIND())

How can I change the columns? Say if the information I need to compare is in columns E? I thought I would just change the A to and E

Sub Button1_Click()

Dim Rws1 As Long, Rng1 As Range, A As Range
Dim Rws2 As Long, Rng2 As Range, C As Range
Dim Sht1 As Worksheet, Sht2 As Worksheet, Sht3 As Worksheet
Set Sht1 = Worksheets(1)
Set Sht2 = Worksheets(2)
Set Sht3 = Worksheets(3)
Rws1 = Sht1.Cells(Rows.Count, "E").End(xlUp).Row
Rws2 = Sht2.Cells(Rows.Count, "E").End(xlUp).Row

Set Rng1 = Range(Sht1.Cells(1, 1), Sht1.Cells(Rws1, 1))
Set Rng2 = Range(Sht2.Cells(1, 1), Sht2.Cells(Rws2, 1))
Application.ScreenUpdating = False
For Each C In Rng2.Cells
For Each A In Rng1.Cells
If C = A Then A.EntireRow.Copy Destination:=Sht3.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Next A
Next C


End Sub