Sub MakeDiagramm()
  Const D0 = 300
  Dim shp, a, c&, i&, m, D, rg As Range
  Set rg = Range(Cells(2, 2), Cells(2, 2).End(xlDown))
  a = rg: c = UBound(a)
  For i = 1 To c: If a(i, 1) > m Then m = a(i, 1)
  Next
  For i = 1 To c
    D = a(i, 1) * D0 / m
    Set shp = ActiveSheet.Shapes.AddShape(msoShapePie, D0 - D / 2, D0 - D / 2, D, D)
    shp.Adjustments.Item(1) = 270 - 360 / c
    rg(i).Interior.ColorIndex = i + 2
    shp.Fill.ForeColor.RGB = rg(i).Interior.Color
    shp.IncrementRotation 360 * (i - 1) / c
  Next
  ActiveSheet.Shapes.SelectAll
  Selection.Group
End Sub