Converting Multiple Rows to One with Multiple Colums

Sub test()
Dim myformula
Dim class As Range
Dim r As Range, unq As Range, cunq As Range, nname As Range, prod As Range
Dim uprod As Range, cprod As Range
Application.ScreenUpdating = False
Range(Range("A1").End(xlDown).Offset(1, 0), Cells(Rows.Count, "A")).EntireRow.Delete
Set nname = Range(Range("A1"), Range("A1").End(xlDown))
Set prod = nname.Offset(0, 2)
Set r = Range("A1").CurrentRegion
Set unq = Range("A1").End(xlDown).Offset(5, 0)
Set uprod = unq.Offset(0, 2)
nname.AdvancedFilter xlFilterCopy, , unq, True
prod.AdvancedFilter xlFilterCopy, , uprod, True
Set unq = Range(unq.Offset(1, 0), unq.End(xlDown))
Set uprod = unq.Offset(0, 2).Resize(prod.Rows.Count)
uprod.Copy
uprod(1, 1).Offset(-1, -1).PasteSpecial Transpose:=True
uprod.Clear
Set uprod = Range(unq(1, 1).Offset(-1, 1), unq(1, 1).Offset(-1, 1).End(xlToRight))
For Each cunq In unq
For Each cprod In uprod
myformula = "=index(" & r.Columns("d:d").Address & ",match(1,(" & nname.Address & "=" & cunq.Address & ")*(" & prod.Address & "=" & cprod.Address & "),0),1)"
Application.Evaluate (myformula)
Application.Intersect(Rows(cunq.Row), Columns(cprod.Column)) = Application.Evaluate(myformula)
Next
Next
Application.ScreenUpdating = True
MsgBox "macro over. see below data"
End Sub