XL 2016 copier un objet sur toutes les feuilles

[andrekn13]

bonjour
je me suis usé à trouver le code, si une bonne âme connaît la démarche ....
ce code fonctionne pour un range mais pour un shapes c'est à chaque fois la misère ...;

Sub Macro9()
Dim Feuille As Worksheet
For Each Feuille In ThisWorkbook.Worksheets
'Feuille.Range("L10") = Sheets("FACT FROID").Range("L10") : CODE QUI FONCTIONNE
'Feuille.Range("L10") = Sheets("FACT FROID").Shapes.Range(Array("Left Arrow 19")) évidemment ça fonctionne pas ...

Sheets("FACT FROID").Shapes.Range(Array("Left Arrow 19")).Copy
Feuille.Range("L10").Paste
Next Feuille
End Sub

le problème est que le "copiage" se fait au hazard, et si l'on veut fixer sur une cellule, on perd la mémoire de la sélection .......
Merci de votre aide ...;

 

[sousou]

Bonjour
Positionne ton shapes après la copy du genre:
Sub copie()
With Sheets(1)
.Shapes("Rectangle 1").Copy
Sheets(2).Paste
Set im = Selection
im.Left = Sheets(2).Range("L10").Left
im.Top = Sheets(2).Range("L10").Top
End With

End Sub

 

[andrekn13]

quand j'isole uniquement ce code :
ActiveSheet.Shapes.Range(Array("Left Arrow 19")).Copy
je ne comprends pas pourquoi ça fonctionne pas ……;

 

[andrekn13]

mon but étant de recopier ce shapes avec une macro liée à toutes mes feuilles

 

[sousou]

Pas vraiment de réponse il semble que shapes.range n'accepte pas toutes les méthodes
copy: non
select: oui
deleteui
Sub test()
ActiveSheet.Shapes.Range(Array("Rectangle 1", "Rectangle 2")).Select
Selection.Copy
End Sub

 

[sousou]

Pourquoi n'utilises tu pas le nom du shapes sans passer par range?

 

[andrekn13]

j'ai essayé
sur la macro du début que j'ai envoyé , c'était le but

 

[andrekn13]

désolé mal lu
passer sans le range ? il me semble qu'il y a un code a faire pour obtenir le nom réel du shapes

 

[andrekn13]

merci pour ton idée !!!!!
ça à l'air de fonctionner
juste que je voulais "faire simple" pour une copie sur toutes les feuilles ; à croire que je doive mettre sur une variable la feuille " activesheets" pour qu'il arrive, apr's avoir copié, revenir sur cette feuille


Sub Macro9()
Dim Feuille As Worksheet
Dim retour As Object
For Each Feuille In ThisWorkbook.Worksheets
'Feuille.Range("L10") = Sheets("FACT FROID").Range("L10") CODE QUI FONCTIONNE
'Feuille.Range("L10") = Sheets("FACT FROID").Shapes.Range(Array("Left Arrow 19")) ? évidemment ?a fonctionne pas ...
'With Worksheets '(NomFeuille)
Set retour = Sheets("FACT FROID").Shapes("Left Arrow 19")
retour.Copy
Feuille.Range("L10").Select : ça bloque à ce niveau
Feuille.Range("L10").Paste '.Range ("L10") 'objet.Copy ActiveSheet.Range("Q9")

'End With
'ActiveSheet.Range ("L10")
Next Feuille
End Sub

 

[eriiic]

Bonjour,

pour faire un .Select d'une cellule il faut que la feuille soit active.
eric

 

[andrekn13]

alors comment faire ?
Puisqu'on demande de revenir sur la feuille où il y le shapes et de le copier , il faut donc revenir sur la feuille que l'on a besoin pour que ce shapes soit copié !!
De plus je recherche à copier ce shapes sur toutes les feuilles de mon classeur ......

 

[Roland_M]

bonsoir,

si j'ai bien compris, copier un shape de la Feuil(1) par exemple sur toutes les autres feuilles !?
ceci fonctionne:

Sub copie()
Sheets(1).Shapes("Rectangle 1").Copy
For Each Feuille In ThisWorkbook.Worksheets
If Feuille.Name <> Sheets(1).Name Then Feuille.Paste
Next Feuille
End Sub

 

[andrekn13]

Ohhhh super !!!!!!!!!!!!!
ça marche !
cerise sur le gâteau , peut-on contrôler l'emplacement du collage ? comme si c'était aléatoire .........

 

[andrekn13]

ton code est si épuré que je suis surpris de sa simplicité ...…….. et pourtant c'est justement le signe d'un code réussi
bravo

 

[Roland_M]

re

comme ceci: (par contre comprend pas trop aléatoire quoi !? la cellule !?)

Sub Copie3()
Sheets(1).Shapes("Rectangle 1").Copy
For Each Feuille In ThisWorkbook.Worksheets
 If Feuille.Name <> Sheets(1).Name Then Feuille.Paste Destination:=Feuille.Cells(5, 5)
Next
End Sub

EDIT: j'ai modifié ! si tu as pris le premier reprends celui-ci !