Compare 2 columns of names and report

Sub test()
Dim r As Range, c As Range, dest As Range
Dim cfind As Range, x As String
With Worksheets("sheet1")
Set r = Range(.Range("c2"), .Range("c2").End(xlDown))
For Each c In r
x = c.Value
With Worksheets("sheet2").Columns("c:c")
Set cfind = .Cells.Find(what:=x, lookat:=xlWhole, LookIn:=xlValues)
If cfind Is Nothing Then GoTo nextc
cfind.EntireRow.Copy
With Worksheets("sheet3")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With
End With
nextc:
Next c
End With


End Sub