I have a workbook with several sheets

DATA Errata and Errata 2

Data contains a large list of value but of interest is column D

I want to find if a partial value listed in Column D matches a value in
column A of errata then copy the value from Column C in Errata to column
D in data


EG

Data sheet column D contains the entry 123456ABC

Errata sheet column A row 3 contains 123456
Errata sheet column C row 3 contains XYZABC12

If the partial match is found I want the value in column D whatever row
it is in to now equal XYZABC12


So on a bigger scale

DATA_D ERRATA_A ERRATA_C
123abc 123 XYZ132
234abc 234a XZY495
678bde 132q PSU091
132qwe 678b ddeeff

Should have column D become
XYZ132
XZY495
ddeeff
PSU091

I've tried this but it doesn't work

Sub ReplaceMatches()

Dim shtOld As Worksheet, shtNew As Worksheet
Dim oldRow As Integer
Dim newRow As Integer
Dim i As Integer, id, f As Range



Set shtOld = ThisWorkbook.Sheets("Errata")
Set shtNew = ThisWorkbook.Sheets("Data")


For oldRow = 2 To 1711

id = shtOld.Cells(oldRow, 1)

Set f = shtNew.Range("D2:D1711").Find(id, , xlValues, xlPart)
If Not f Is Nothing Then
shtNew.activeCell.value = shtOld.Cells(oldRow, 3)


End If

Next oldRow

I know I'm not getting the right cell somewhere. Can someone help?