Sub Poisk()
Dim i As Long
Dim iLastRow As Long
Dim FoundCell As Range
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
 Range("C3:C" & iLastRow).ClearContents
  For i = 3 To iLastRow
    If Not IsEmpty(Cells(i, "A")) Then
     If SheetExist(Cells(i, "B")) Then
      With Worksheets(Cells(i, 2).Text)
       Set FoundCell = .Columns("B").Find(Cells(i, "A"), , xlValues, xlWhole)
        If Not FoundCell Is Nothing Then
          Cells(i, "C") = .Cells(FoundCell.Row, "C")
        End If
      End With
     End If
    End If
  Next
End Sub
Function SheetExist(iName As String) As Boolean
    On Error Resume Next
    With Worksheets(iName): End With
    SheetExist = (Err = 0)
End Function