Sub Вставить_гиперссылки()

    Dim arr(), strFullName As String, strRes As String
    Dim lr As Long, i As Long, j As Long
    
    Application.ScreenUpdating = False
    
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    arr() = Range("A1:D" & lr).Value
    Range("C3:D" & lr).ClearContents
    
    On Error Resume Next
    For i = 3 To UBound(arr)
        For j = 3 To 4
            strFullName = "\\PTZ\сканы\" & Left(arr(i, 2), 4) & "\" & arr(2, j)
            strRes = ""
            strRes = Dir(strFullName)
            If strRes <> "" Then
                Cells(i, j).Formula = "=HYPERLINK(""" & strFullName & """,""копия"")"
            End If
        Next j
    Next i
    On Error GoTo 0
    
    MsgBox "Готово!", vbInformation
    Application.ScreenUpdating = True
    
End Sub