Macro pour copier/coller une shape vers une autre feuille

[mexitinoco]

Bonjour à tous,

Je bloque sur une macro toute bête depuis plusieurs jours, j'ai regardé les solutions sur divers forums mais rien à faire ça ne marche toujours pas...
En fait cette macro sélectionne la shape située sur un champ de cellules donné (ici S20:T27, en l'occurence cette partie là marche), et après copie la shape sélectionnée sur l'autre feuille du classeur, appelée "blabla". Et c'est au moment de coller sur l'autre feuille que ça coince, je pense que je dois faire une erreur de syntaxe dans l'écriture de la feuille.
Ci-dessous mon code :

Sub copier_sch?mas()
Dim s As Shape
Set classeur = ThisWorkbook
For Each s In ActiveSheet.Shapes
If Not Intersect(s.TopLeftCell, Range("S20:T27")) Is Nothing Then
s.Select False
Selection.Copy classeur.Sheets("blabla").Paste.Range("A1")
End If
Next s

End Sub

Des idées ?

 

[mexitinoco]

Autant pour moi je viens de trouver, comme quoi ^^

Je vous mets le code ci-dessous si jamais ça peut vous intéresser :

Sub copier_schemas()
Dim s As Shape, classeur As Workbook
Set classeur = ThisWorkbook
For Each s In ActiveSheet.Shapes
If Not Intersect(s.TopLeftCell, Range("S20:T27")) Is Nothing Then
s.Select False
Selection.Copy
Sheets("blabla").Select
Range("A1").Select
ActiveSheet.Paste
End If
Next s

End Sub

Bon par contre c'est pas très académique je pense, donc si jamais vous avez des suggestions d'amélioration c'est avec plaisir !

 

[Hasco]

Bonjour,

Ou sans select de la feuille blabla:

Sub copier_schemas()
    Dim s As Shape
    With ThisWorkbook
    For Each s In ActiveSheet.Shapes
        If Not Intersect(s.TopLeftCell, Range("S20:T27")) Is Nothing Then
            s.Copy
            ThisWorkbook.Sheets("blabla").Paste ThisWorkbook.Sheets("blabla").Range("A1")
        End If
    Next s
    End With
End Sub

Bonne journée

 

[mexitinoco]

Bonjour Roblochon,

Effectivement comme ça ça marche aussi et c'est beaucoup plus propre ! Merci !

 

[Staple1600]

Bonjour le fil,

Une autre façon de faire (sans boucle et avec la méthode Duplicate) et avec une macro paramétrée.
Pré-requis
La forme à copier possède un nom que l'on connait
Exemple ci-dessous, j'ai renommé la forme: FormeTest

Sub test()
CopierShape Sheets(1), Sheets(2), "FormeTest"
End Sub
Private Sub CopierShape(ws1 As Worksheet, ws2 As Worksheet, shpNom As String)
Dim shp As Shape
Set shp = ws1.Shapes(shpNom).Duplicate
shp.Cut: ws2.Paste
ws2.Shapes(shpNom).Name = shpNom & "_Copie"
End Sub