Macro - graphique - nuage de points

'### Constante de la 1ère ligne (à adapter) ###
Const FIRST_LIG As Long = 5
'##############################################

Type StructAdresse
  Abs As String
  Ord As String
End Type

Sub SeriesNuage()
Dim S As Worksheet
Dim R As Range
Dim LastCol&
Dim LastLig&
Dim j&
Dim cpt&
Dim T() As StructAdresse
Dim CH As Chart
Dim A$
If TypeName(Selection) <> "Range" Then
  MsgBox "Veuillez sélectionner une cellule."
  Exit Sub
End If
On Error GoTo Erreur
'--- Adresse des séries ---
Set S = ActiveSheet
LastCol& = S.Range("iv" & FIRST_LIG & "").End(xlToLeft).Column
ReDim T(1 To (LastCol& + 1) / 6)
For j& = 2 To LastCol& Step 6
  Set R = S.Range(Cells(FIRST_LIG, j&), Cells(FIRST_LIG, j&))
  If Not IsEmpty(R.Offset(1, 0)) Then
    LastLig& = R.End(xlDown).Row
  Else
    LastLig& = FIRST_LIG
  End If
  cpt& = cpt& + 1
    '°°° Adresse des X °°°
  T(cpt&).Abs = S.Range(Cells(FIRST_LIG, j&), _
      Cells(LastLig&, j&)).Address(True, True, xlR1C1)
    '°°° Adresse des Y °°°
  T(cpt&).Ord = S.Range(Cells(FIRST_LIG, j& + 3), _
      Cells(LastLig&, j& + 3)).Address(True, True, xlR1C1)
Next j&
'--- Construction des séries ---
Application.ScreenUpdating = False
A$ = "=" & S.Name & "!"
Set CH = Charts.Add
CH.ChartType = xlXYScatterSmooth
For j& = 1 To UBound(T)
  CH.SeriesCollection.NewSeries
  CH.SeriesCollection(j&).XValues = A$ & T(j&).Abs
  CH.SeriesCollection(j&).Values = A$ & T(j&).Ord
Next j&
CH.Location Where:=xlLocationAsObject, Name:=S.Name
ActiveChart.Deselect
Erreur:
Application.ScreenUpdating = True
If Err <> 0 Then MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
End Sub