Sub DDDR()

Dim shV As Worksheet, shITR As Worksheet, rng As Range
Dim ActualDate As Date, Nudost As String, r0 As Long, r1 As Long, i As Long
Dim oXL As Workbook
Dim FileToOpen As String, sStr As String

Set shV = ThisWorkbook.Sheets("Âàõòà+Ïîäìåííûå")
Set shITR = ThisWorkbook.Sheets("ÈÒÐ")

FileToOpen = "C:\Users\t506.hse\Desktop\Îçíàêîìëåíèå Èãîðÿ\TestVBA\Ýëåêòðîííàÿ ôîðìà ïî ÎÒ2 VBA test 1.xlsm"
Set oXL = Workbooks.Open(FileToOpen)
sStr = oXL.Sheets("01-Æóðíàë")

ActualDate = sStr.Range("B4")
r0 = 4
r1 = 42

For i = r0 To r1
If ActiveSheet.Cells(i, "D") <> "" Then
Nudost = ActiveSheet.Cells(i, "D")
Set rng = shV.Columns(2).Find(What:=Nudost, LookAt:=xlWhole)
If Not rng Is Nothing Then
rng.Offset(1, 4) = DateAdd("yyyy", 1, ActualDate)
Else
Set rng = shITR.Columns(2).Find(What:=Nudost, LookAt:=xlWhole)
If Not rng Is Nothing Then rng.Offset(1, 4) = DateAdd("yyyy", 1, ActualDate)
End If
End If
Next i
End Sub