Sub tt()
Dim i&, r

Set r = Sheets("Полный список").[P4].CurrentRegion


With CreateObject("Scripting.Dictionary")
For i = 2 To r.Rows.Count
If Not .exists(r(i).Value) Then .Item(r(i).Value) = r(i).Address
Next

Set r = Sheets("2").[A2].CurrentRegion
For i = 2 To r.Rows.Count
If r(i).Hyperlinks.Count > 0 Then r(i).Hyperlinks().Delete
r(i).Hyperlinks.Add Anchor:=r(i), Address:="", SubAddress:= _
        "'" & Sheets("Полный список").Name & "'!" & .Item(r(i).Value), TextToDisplay:=r(i).Value

Next
End With

End Sub

Sub tt()
Dim i&, r, k

Set r = Sheets("Полный список").[P4].CurrentRegion

With CreateObject("Scripting.Dictionary")
'собираем в словарь все Федеральные_проекты, с адресами ячеек
For i = 2 To r.Rows.Count
If Not .exists(r(i).Value) Then .Item(r(i).Value) = r(i).Address
Next

i = 0
'ставим на активный лист с треьей строки ссылки в первый столбец на Федеральные_проекты
For Each k In .keys
i = i + 1
If Cells(i + 2, 1).Hyperlinks.Count > 0 Then Cells(i + 2, 1).Hyperlinks().Delete
Cells(i + 2, 1).Hyperlinks.Add Anchor:=Cells(i + 2, 1), Address:="", SubAddress:= _
        "'" & Sheets("Полный список").Name & "'!" & .Item(k), TextToDisplay:=k

Next
End With

End Sub