pb avec generation graphique

[naima]

voici mon pb j'utilise une boucle pour creer des graph mais ca bug au bout du 99ieme je ne sais pas comme faire ca doit etre un pb de memoire
mais j'ai plus de 400 graph a faire

Private Sub CmdButtonGraph_Click()

Dim compteur As Integer
compteur = 0
myarray = Sheets("DonnéesRéparties").Range("a1:a500")

For Each cellule In myarray
If IsEmpty(cellule) = False Then
Range("e1").Value = cellule
NomFeuil1 = cellule
Drtemp = Range("g1")
Sheets("MODELE").Copy After:=Sheets("MODELE")
ActiveSheet.Name = NomFeuil1
NomFeuil = "'" + NomFeuil1 + "'"
compteurF = ActiveSheet.Index

ActiveSheet.DrawingObjects("Graphique 2").Select
ActiveSheet.ChartObjects("Graphique 2").Activate

ActiveChart.SeriesCollection(1).Select
With ActiveChart.SeriesCollection(1)
.Name = "=" + NomFeuil + "!L9C1"
.Values = "=" + NomFeuil + "!L9C2:L9C19"
End With

ActiveChart.SeriesCollection(2).Select
With ActiveChart.SeriesCollection(2)
.Name = "=" + NomFeuil + "!L11C1"
.Values = "=" + NomFeuil + "!L11C2:L11C19"
End With

ActiveChart.SeriesCollection(3).Select
With ActiveChart.SeriesCollection(3)
.Name = "=" + NomFeuil + "!L12C1"
.Values = "=" + NomFeuil + "!L12C2:L12C19"
End With

ActiveChart.SeriesCollection(4).Select
With ActiveChart.SeriesCollection(4)
.Name = "=" + NomFeuil + "!L8C1"
.Values = "=" + NomFeuil + "!L8C2:L8C19"
End With

ActiveChart.SeriesCollection(5).Select
With ActiveChart.SeriesCollection(5)
.Name = "=" + NomFeuil + "!L10C1"
.Values = "=" + NomFeuil + "!L10C2:L10C19"
End With

ActiveWindow.Visible = False

Sheets("graph").Select
Range("A15:L20").Select
Selection.Copy
Sheets(NomFeuil1).Select
Sheets(NomFeuil1).Range("A1").Select

Selection.PasteSpecial Paste:=xlValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

Sheets("graph").Select
Range("A8:S13").Select
Application.CutCopyMode = False
Selection.Copy

Sheets(NomFeuil1).Select
Sheets(NomFeuil1).Range("A7").Select

Selection.PasteSpecial Paste:=xlFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets(NomFeuil1).Range("A12").Select
vmini = Sheets(NomFeuil1).Range("B6")
vmaxi = Sheets(NomFeuil1).Range("H6")

ActiveWindow.SmallScroll Down:=13
ActiveSheet.DrawingObjects("Graphique 2").Select
ActiveSheet.ChartObjects("Graphique 2").Activate
ActiveChart.Axes(xlValue).Select
Application.CutCopyMode = False
With ActiveChart.Axes(xlValue)
.MinimumScale = vmini
.MaximumScaleIsAuto = vmaxi
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = False
ActiveWindow.Visible = False
End With

''Exportation en image du graphique (feuille active)

Set Plage = ActiveSheet.Range("A14:S52")
ActiveWindow.GridlineColor = RGB(255, 255, 255)
Application.ScreenUpdating = False
Workbooks.Add
Plage.CopyPicture
ActiveSheet.Paste
ActiveSheet.PageSetup.Zoom = 90
ActiveSheet.PageSetup.PrintArea = "$A$1:$M$42"
ActiveSheet.PageSetup.Orientation = xlLandscape
ActiveSheet.PageSetup.CenterHorizontally = True
ActiveSheet.PageSetup.CenterVertically = True
ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(0.5)
ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(0.5)
ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(0.5)
ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.5)
ActiveSheet.PageSetup.HeaderMargin = Application.InchesToPoints(0.5)
ActiveSheet.PageSetup.FooterMargin = Application.InchesToPoints(0.5)

ActiveSheet.SaveAs "c:\user\DRExcel\dr" & Drtemp & "\" & NomFeuil1
ActiveWorkbook.Close
Application.DisplayAlerts = False
Sheets(NomFeuil1).delete
Application.CutCopyMode = False

End If
Next cellule

ActiveWorkbook.Close

Exit_Err:
Exit Sub

Err:
MsgBox Error$
Resume Exit_Err
End Sub