Working with Mutiple Sheets with VBA

[zero635]

I was wondering if there is a simpler method to my madness. I have a value in column "D" that is a company name, next to it I have a blank for a company ID. Sheet 2 in column "B" I have a company name, and in "A" I have a company ID. How can I have it look at Sheet 1 company then compare it to Sheet2 and then return the ID to the blank on Sheet1? Here is what I have written, but it takes forever to run it this way and was wondering if there is a simpler and faster method. Bare with me I am semi-noob at the keyboard...

With the below code, I am basically copying the value over to Sheet2 then doing the search, if it matches a value on sheet2 then it copies the value for the ID and pastes it over to Sheet1. It works but takes about 10 minutes to run on a sheet with about 600 lines. Any help would be greatly appreciated.

Sub Find()
Application.ScreenUpdating = False
Dim wrksht1 As String
Dim wrksht2 As String

wrksht1 = "SW_UPLOAD"
wrksht2 = "VNDR LISTING"

Sheets(wrksht1).Select
Range("E2").Select

ActiveCell.Offset(0, -1).Copy
Sheets(wrksht2).Select
ActiveSheet.Range("c2").PasteSpecial xlPasteValues
ActiveSheet.Range("B2").Select

Do
Sheets(wrksht2).Select
If ActiveCell.Value = ActiveSheet.Range("C2").Value Then
    ActiveCell.Offset(0, -1).Copy
    Sheets(wrksht1).Select
    ActiveCell.PasteSpecial xlPasteValues
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Offset(0, -1).Copy
    Sheets(wrksht2).Select
    ActiveSheet.Range("C2").PasteSpecial xlPasteValues
    ActiveSheet.Range("B2").Select
ElseIf ActiveCell.Value = BLANK Then
    Sheets(wrksht1).Select
    ActiveCell.Value = "No Match Found"
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Offset(0, -1).Copy
    Sheets(wrksht2).Select
    ActiveSheet.Range("C2").PasteSpecial xlPasteValues
    ActiveSheet.Range("B2").Select
ElseIf ActiveCell.Value <> Range("C2").Value Or ActiveCell.Value = BLANK Then
    ActiveCell.Offset(1, 0).Select
    
End If

Sheets(wrksht1).Select
Loop Until ActiveCell.Offset(0, -1).Value = BLANK
Application.ScreenUpdating = True
End Sub