Copier/coller Graphique avec prise en compte d'une nouvelle plage de cellule

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

suistrop

XLDnaute Impliqué
Bonjour,

Je souhaite pouvoir copier/coller des graphiques dans le meme onglets.
Je souhaite que ces graphiques prennent directement les données à l'endroit ou je le colle, de la meme manière que si je faisait un couper/coller.

Voir l'expemple en piece jointe.
Comment faire pour copier la zone fluo dans les autres zone ci dessous en ayant les nouveau graphique qui point sur la plage de donnée juste au dessus.

Merci !

==> Le but in fine est d'avoir un template et de pouvoir l'utiliser en copier collant ou je le souhaite.
 

Pièces jointes

Re : Copier/coller Graphique avec prise en compte d'une nouvelle plage de cellule

Bonjour suistrop,

La macro en Feuil1 du fichier joint :

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim co As ChartObject, t
If Target.Column = 2 And Target.Row >= 15 And (Target.Row - 15) Mod 13 = 0 Then
  Cancel = True
  For Each co In ChartObjects
    If co.TopLeftCell.Address = Target(4).Address Then co.Delete: Exit For
  Next
  t = Target.Resize(4, 8)
  [B2:I13].Copy Target
  Target.Resize(4, 8) = t
  For Each co In ChartObjects
    If co.TopLeftCell.Address = Target(4).Address Then Exit For
  Next
  co.Chart.SeriesCollection(1).XValues = Target(1, 2).Resize(, 7)
  co.Chart.SeriesCollection(1).Name = Target(2)
  co.Chart.SeriesCollection(1).Values = Target(2, 2).Resize(, 7)
  co.Chart.SeriesCollection(2).Name = Target(3)
  co.Chart.SeriesCollection(2).Values = Target(3, 2).Resize(, 7)
End If
End Sub
Double-clic en B15-B28-B41 etc... pour créer les graphiques.

A+
 

Pièces jointes

Re : Copier/coller Graphique avec prise en compte d'une nouvelle plage de cellule

Re,

Une solution qui a l'avantage de fonctionner quel que soit le type de graphique :

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim co As ChartObject, t
If Target.Column = 2 And Target.Row >= 15 And (Target.Row - 15) Mod 13 = 0 Then
  Cancel = True
  Application.ScreenUpdating = False
  For Each co In ChartObjects
    If co.TopLeftCell.Address = Target(4).Address Then co.Delete: Exit For
  Next
  t = Target.Resize(4, 8)
  Me.Copy 'nouveau document
  ActiveSheet.[B2:I13].Cut Target 'couper-coller
  ActiveWorkbook.Close False
  Target.Resize(4, 8) = t
End If
End Sub
Elle est vraiment très simple, c'est celle qu'il faut retenir.

Fichier (2).

A+
 

Pièces jointes

Re : Copier/coller Graphique avec prise en compte d'une nouvelle plage de cellule

Bonjour Job75,

Merci pour ta réponse, le truc qui m’embête est que ca m'oblige à passer par un classeur intermédiaire(à cause du couper/coller) :/
J'aurais bien aimé que tout se passe dans un seul classeur !

Cordialement,
 
Re : Copier/coller Graphique avec prise en compte d'une nouvelle plage de cellule

Re,

En créant une nouvelle feuille on ne sort pas du classeur :

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim co As ChartObject, t
If Target.Column = 2 And Target.Row >= 15 And (Target.Row - 15) Mod 13 = 0 Then
  Cancel = True
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  For Each co In ChartObjects
    If co.TopLeftCell.Address = Target(4).Address Then co.Delete: Exit For
  Next
  t = Target.Resize(4, 8)
  Me.Copy Before:=Me 'nouvelle feuille
  ActiveSheet.[B2:I13].Cut Target 'couper-coller
  ActiveSheet.Delete
  Target.Resize(4, 8) = t
End If
End Sub
Fichier (3).

Re-bonne fin de soirée.
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour