The following assumes your data is in cells A1:B5 of Sheet1.
Sub Macro1()
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
ws.Range("B1:B5").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ws.Range("E1"), Unique:=True
ws.Range("D2").FormulaR1C1 =
"=SUMIF(RC[-2]:R[3]C[-2],RC[1],RC[-3]:R[3]C[-3])"
ws.Range("D2").Copy ws.Range("D3")
ws.Range("D2:E3").Copy
ws.Range("D2").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws.Range("A2:B5").Clear
ws.Range("D2:E3").Copy ws.Range("A2")
ws.Range("D1:E3").Clear
End Sub
Hth,
Merjet
|