Compare names and copy data on two sheets

Here's one way...

Option Explicit

Sub Find()
Dim i As Long, lRow As Long, Name As String, rng As Range
Application.ScreenUpdating = False
With Sheet1
    lRow = .Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To lRow
        Name = Range("A" & i)
        With Sheets("Sheet2").Range("A:A")
                Set rng = .Find(What:=Name, _
                                After:=.Cells(1), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False)
                If Not rng Is Nothing Then
                    Sheet1.Range("B" & i) = rng.Offset(, 1)
                    Sheet1.Range("C" & i) = rng.Offset(, 2)
                Else
                    MsgBox "Name does not exist"
                End If
        End With
    Next i
End With
Application.ScreenUpdating = True
End Sub

Edited:
Or another

Option Explicit

Sub Find2()
Dim cell As Range, rng As Range, Name As String
Application.ScreenUpdating = False
For Each cell In Sheet1.Range(Range("A2"), Range("A2").End(xlDown))
    Name = cell
    With Sheet2.Range("A:A")
        Set rng = .Find(Name, LookIn:=xlValues, lookat:=xlWhole)
            If Not rng Is Nothing Then
                cell.Offset(, 1) = rng.Offset(, 1)
                cell.Offset(, 2) = rng.Offset(, 2)
            End If
    End With
Next cell
Application.ScreenUpdating = True
End Sub

See attached in Post2

Glad i could help. thanks for rep+