Using your uploaded file, this seemed to work.
Sub t()
Dim c As Range, fn As Range, i As Long
With Sheets("Sheet1")
For Each c In .Range("G2", .Cells(Rows.Count, 7).End(xlUp))
Set fn = Sheets("Result").Range("C2", Sheets("Result").Cells(Rows.Count, 3).End(xlUp)).Find(c.Offset(, -4).Value, , xlValues, xlWhole)
If Not fn Is Nothing Then
With Sheets("Result")
For i = 6 To .Cells(1, Columns.Count).End(xlToLeft).Column
'MsgBox Month(.Cells(1, i).Value) & vbLf & Month(c.Offset(, -1).Value)
If Month(.Cells(1, i).Value) = Month(c.Offset(, -1).Value) And _
Year(.Cells(1, i).Value) = Year(c.Offset(, -1).Value) Then
.Cells(fn.Row, i) = c.Value
End If
Next
End With
End If
Next
End With
End Sub
Bookmarks