Function GetFileName(Optional ByVal Title As String = "Выберите файл для обработки", _
Optional ByVal InitialPath, _
Optional ByVal MyFilter As String = "Книги Excel (*.xls*),") As String
' функция выводит диалоговое окно выбора папки с заголовком Title,
' начиная обзор диска с папки InitialPath
' возвращает полный путь к выбранной папке, или пустую строку в случае отказа от выбора
If Not IsMissing(InitialPath) Then
On Error Resume Next: ChDrive Left(InitialPath, 1)
ChDir InitialPath ' выбираем стартовую папку
End If
res = Application.GetOpenFilename(MyFilter, , Title, "Открыть") ' вывод диалогового окна
GetFileName = IIf(VarType(res) = vbBoolean, "", res) ' пустая строка при отказе от выбора
End Function

Public Sub ПРFДтКт()
Dim strFN As String, strTWb$
Dim wb2 As Workbook
Dim oDict
Dim str1 As String
Const strLN1 As String = "ПР-5"
Const strLN2 As String = "Page5"

strFN = GetFileName("Выберите файл для обработки", ThisWorkbook.Path) ' запрашиваем имя файла
If strFN = "" Then Exit Sub
strTWb = ActiveWorkbook.FullName
If strFN = strTWb Then Exit Sub
Set oDict = CreateObject("Scripting.Dictionary")
oDict.CompareMode = 1

With ActiveWorkbook.Sheets(strLN1)
For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
oDict.Item(.Cells(i, 1).Value) = .Cells(i, 2).Value
Next i
End With
Set wb2 = Workbooks.Open(strFN)
With wb2.Sheets(strLN2)
For i = 16 To .Cells(Rows.Count, 51).End(xlUp).Row
str1 = .Cells(i, 51)
.Cells(i, 53).Value = oDict.Item(str1)

Next
End With

wb2.Close
End Sub