Macro création graphique

Sub MakeGraph()
Dim S As Worksheet
Dim R As Range
Dim C As Range
Dim C2 As Range
Dim A$
Dim B$
Dim CH As Chart
On Error GoTo Erreur
Set S = ActiveSheet
Set R = S.Cells.SpecialCells(xlCellTypeFormulas)
For Each C In R
  If InStr(1, C.Formula, "SUBTOTAL") Then
    If Len(C.Offset(0, 2)) > Len("Total") Then
      A$ = A$ & "'" & S.Name & "'!" & _
          C.Address(True, True, xlR1C1) & ","
      Set C2 = C.Offset(0, 2)
      B$ = B$ & "'" & S.Name & "'!" & _
          C2.Address(True, True, xlR1C1) & ","
    End If
  End If
Next C
A$ = "=(" & Mid(A$, 1, Len(A$) - 1) & ")"
B$ = "=(" & Mid(B$, 1, Len(B$) - 1) & ")"
Set CH = Charts.Add
With CH
  .ChartType = xlPie
  .SeriesCollection.NewSeries
  With .SeriesCollection(1)
    .Values = A$
    .XValues = B$
    .ApplyDataLabels AutoText:=True, _
      ShowCategoryName:=True, _
      ShowPercentage:=True, _
      LegendKey:=True
  End With
  .Legend.Delete
  .Location Where:=xlLocationAsObject, Name:=S.Name
End With
With ActiveChart
  With .PlotArea
    .Border.LineStyle = xlNone
    .Interior.ColorIndex = xlNone
  End With
  .Deselect
End With
Erreur:
If Err <> 0 Then MsgBox "Erreur " & Err.Number & vbCrLf _
  & Err.Description & vbCrLf & "Arrêt sur la feuille " & ActiveSheet.Name
End Sub