I would do this one:
Sub CopyPaste()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim res
Set ws1 = Worksheets("Sheet2")
Set ws2 = Worksheets("Sheet3")
res = Application.Match("*" & ws1.Range("A2") & "*", ws2.Range("1:1"), 0)
If IsError(res) Then
MsgBox "Nothing found"
Exit Sub
End If
ws2.Cells(2, res).Value = ws1.Range("D16").Value
End Sub
for exact match use res = Application.Match(ws1.Range("A2"), ws2.Range("1:1"), 0)