Trier sans doublon et du plus grand nombre au plus petit

Sub class()
  Set Rng = Range("d2:E" & [D65000].End(xlUp).Row)
  tbl = Rng.Value
  Set d = CreateObject("scripting.dictionary")
  For i = 1 To UBound(tbl)
    d(tbl(i, 1)) = tbl(i, 2)
  Next i
  [G2].Resize(d.Count) = Application.Transpose(d.keys)
  [H2].Resize(d.Count) = Application.Transpose(d.items)
  [G2].CurrentRegion.Sort key1:=[H2], Order1:=xlDescending, Header:=xlNo
End Sub