Bonjour,
Ci-dessous la procédure commentée.
Pense à clore le sujet.
Cdlt.
Option Explicit
Public Sub CopyData()
'Déclaration des variables
Dim ws As Worksheet
Dim lastRow As Long
Dim rCell As Range
Dim objChart As ChartObject, objChart2 As ChartObject
Dim rngX As Range, rngY As Range, rngZ As Range
Dim n As Long
'Optimisation procédure (gel affichage)
Application.ScreenUpdating = False
'Feuille active (U)
Set ws = ActiveSheet
With ws
'Dernière ligne colonne B
lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
'Copie des données
.Cells(3, 2).CurrentRegion.Copy
.Cells(lastRow + 4, 2).PasteSpecial xlPasteValues
Application.CutCopyMode = False
'1ère. cellule de la sélection copiée
Set rCell = Selection.Cells(1)
'Dernière ligne colonne B
lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
'Nombre de lignes pour redimensionner les plages des axes du graphiques
n = lastRow - rCell.Row
'Initialisation des plages pour le graphique
Set rngX = rCell.Offset(1).Resize(n)
Set rngY = rCell.Offset(1, 2).Resize(n)
Set rngZ = rCell.Offset(1, 3).Resize(n)
'Initialisation des variables
'Graphique initial à copier
'(1) dans l'exemple car il n'y a qu'un graphique, sinon le nommer
Set objChart = .ChartObjects(1)
'Nouveau graphique
Set objChart2 = objChart.Duplicate.Chart.Parent
With objChart2
'Position du graphique dans la feuille
.Left = rCell.Offset(, 5).Left
.Top = rCell.Offset(, 5).Top
End With
With objChart2.Chart
'Axe X (colonne B)
.SeriesCollection(1).XValues = rngX
'Axe Y (colonne D)
.SeriesCollection(1).Values = rngY
'Barre erreur (colonne E)
.SeriesCollection(1).ErrorBar _
Direction:=xlY, _
Include:=xlBoth, _
Type:=xlCustom, _
Amount:=rngZ, _
minusvalues:=rngZ
End With
End With
'RAZ variables (on libère la mémoire utilisée)
Set rngZ = Nothing: Set rngY = Nothing: Set rngX = Nothing
Set objChart2 = Nothing: Set objChart = Nothing
Set rCell = Nothing
Set ws = Nothing
End Sub