Sub Test()
Dim graphXY As Chart, nouvSerie As Series, i As Long, cpt As Long, feuilSource As Worksheet, zoneGraphique As Range
Dim tabSeries() As Variant, dicoSeries As Object, nbSeries As Long, nbPts As Long, tabValX() As Double, tabValY() As Double, derLig As Long, zoneSeries As Range, cellR As Range, memAdr As String
'initialiser les variables
Set feuilSource = ThisWorkbook.Sheets("Data")
Set zoneGraphique = feuilSource.Range("F20:M35")
'récupérer la liste des séries (colonne A)
derLig = feuilSource.Cells(feuilSource.Rows.Count, 1).End(xlUp).Row
Set dicoSeries = CreateObject("Scripting.Dictionary")
On Error Resume Next
For i = 2 To derLig
dicoSeries.Add feuilSource.Cells(i, 1).Text, feuilSource.Cells(i, 1).Text
Next i
On Error GoTo 0
tabSeries = dicoSeries.Items
'créer un nouveau graphique (de type XY Scatter)
With zoneGraphique
Set graphXY = .Parent.ChartObjects.Add(.Left, .Top, .Width, .Height).Chart
End With
graphXY.ChartType = xlXYScatter
Set zoneSeries = feuilSource.Range(feuilSource.Cells(2, 1), feuilSource.Cells(derLig, 1))
'boucler sur chaque série
For i = LBound(tabSeries) To UBound(tabSeries)
'récupérer les points de la série
nbPts = WorksheetFunction.CountIf(zoneSeries, tabSeries(i))
ReDim tabValX(1 To nbPts)
ReDim tabValY(1 To nbPts)
cpt = 0
Set cellR = zoneSeries.Find(tabSeries(i), , xlValues, xlWhole)
If Not cellR Is Nothing Then
memAdr = cellR.Address
Do
cpt = cpt + 1
tabValX(cpt) = cellR.Offset(0, 1).Value
tabValY(cpt) = cellR.Offset(0, 2).Value
Set cellR = zoneSeries.FindNext(cellR)
Loop Until cellR.Address = memAdr
End If
'ajouter la série au graphique
Set nouvSerie = graphXY.SeriesCollection.NewSeries
nouvSerie.Name = tabSeries(i)
nouvSerie.XValues = tabValX
nouvSerie.Values = tabValY
Next i
End Sub