Мне нравится так:  
 
Sub MicroGraph()  
On Error Resume Next  
Dim rng As Range  
ws = ActiveSheet.Name  
Set rng = Selection  
   Set ac = ActiveSheet.ChartObjects.Add(rng.Left - 3, rng.Top - 2, rng.Width + 6, rng.Height + 4)  
   ac.Activate  
   ActiveChart.ChartType = xlColumnClustered  
   ActiveChart.SetSourceData Source:=Sheets(ws).Range(rng.Offset(0, -1), Sheets(ws).Cells(rng.Row, 2)), PlotBy _  
       :=xlRows  
   ActiveChart.Location Where:=xlLocationAsObject, Name:=ws  
   With ActiveChart  
       .Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic  
       .Axes(xlCategory).HasMajorGridlines = False  
       .Axes(xlCategory).HasMinorGridlines = False  
       .Axes(xlValue).HasMajorGridlines = False  
       .Axes(xlValue).HasMinorGridlines = False  
       .Axes(xlValue).MinimumScaleIsAuto = True  
       .Axes(xlValue).MaximumScaleIsAuto = True  
       .Axes(xlValue).MinorUnitIsAuto = True  
       .Axes(xlValue).MajorUnitIsAuto = True  
       .Axes(xlValue).Crosses = xlAutomatic  
       .Axes(xlValue).ReversePlotOrder = False  
       .Axes(xlValue).ScaleType = xlLinear  
       .Axes(xlValue).DisplayUnit = xlNone  
       .HasAxis(xlCategory, xlPrimary) = False  
       .HasAxis(xlValue, xlPrimary) = False  
       .HasLegend = False  
       .PlotArea.ClearFormats  
       .PlotArea.Left = 1  
       .PlotArea.Top = 1  
       .ChartArea.Border.Weight = 2  
       .ChartArea.Border.LineStyle = 0  
       .ChartArea.Interior.ColorIndex = xlNone  
       .PlotArea.Width = rng.Width  
       .PlotArea.Height = rng.Height - 2  
       .ChartGroups(1).Overlap = 0  
       .ChartGroups(1).GapWidth = 10  
       .ChartGroups(1).HasSeriesLines = False  
       .HasTitle = False  
   End With  
   With ActiveChart.SeriesCollection(1)  
       .Border.Weight = xlThin  
       .Border.LineStyle = xlNone  
       .Shadow = False  
       .InvertIfNegative = False  
       .Interior.ColorIndex = 41  
       .Interior.Pattern = xlSolid  
       .AxisGroup = 1  
       .ErrorBar Direction:=xlY, Include:=xlNone, _  
               Type:=xlFixedValue, Amount:=0.05  
       .ApplyDataLabels AutoText:=True, LegendKey:= _  
               False, ShowSeriesName:=False, ShowCategoryName:=False, ShowValue:=False, _  
               ShowPercentage:=False, ShowBubbleSize:=False  
   End With  
End Sub  
Sub GraphAll()  
Application.ScreenUpdating = False  
clc = Application.Calculation  
Application.Calculation = xlCalculationManual  
For Each c In Selection.Cells  
c.Select  
Call MicroGraph  
Next c  
Application.Calculate  
Application.Calculation = clc  
Application.ScreenUpdating = True  
End Sub