ضع الكود في حدث الورقة وجرب ان شاءالله ياتي بثماره
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False
On Error Resume Next
For Each c In Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row)
X = Cells(c.Row, Columns.Count).End(xlToLeft).Column + 1
If c = "Yes" Then
If Cells(c.Row, X) = "" Then
Cells(c.Row, X).Value = c.Offset(, -3).Value
End If
End If
Next c
Application.EnableEvents = True
End Sub