Sub transp()
    Dim r As Long, c As Integer, rt As Long
    Dim sh As Worksheet, sht As Worksheet
    Set sh = ThisWorkbook.Sheets("Новый прайс")
    ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    Set sht = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    sht.Name = "tmp"
    rt = 2
    For r = 2 To sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
        c = 4
        While sh.Cells(r, c) <> ""
            sht.Cells(rt, 1) = sh.Cells(r, 1)
            sht.Cells(rt, 2) = sh.Cells(r, 2)
            sht.Cells(rt, 3) = sh.Cells(r, 3)
            sht.Cells(rt, 4) = sh.Cells(1, c)
            sht.Cells(rt, 5) = sh.Cells(r, c)
            rt = rt + 1
            c = c + 1
        Wend
    Next r
    MsgBox "Done"
End Sub

Sub Price()
Dim wsMyPrice As Worksheet, wsNewPice As Worksheet
Dim MyPrice(), NewPrice(), x&, r&, i&
Set wsMyPrice = ThisWorkbook.Sheets("Наш прайс")
Set wsNewPice = ThisWorkbook.Sheets("Новый прайс")
MyPrice = wsMyPrice.Range("A1").CurrentRegion.Value
NewPrice = wsNewPice.Range("A1").CurrentRegion.Value
For x = 2 To UBound(MyPrice, 1)
    For r = 2 To UBound(NewPrice, 1)
        If MyPrice(x, 3) = NewPrice(r, 2) Then
            For i = 4 To UBound(NewPrice, 2)
                If MyPrice(x, 2) = NewPrice(r, i) Then wsMyPrice.Range("E" & x) = NewPrice(r, 3)
            Next i
        End If
    Next r
Next x
End Sub

=ЕСЛИ(ЕСЛИОШИБКА(ПОИСКПОЗ(B2;'Новый прайс'!2:2;0);"")<>"";'Новый прайс'!C2;"")