Get name of shape and copy to another sheet

[haseft]

Hi!

In activecell there is a shape.
I want to get its name and copy it to another sheet.
Please help.

Sub CopyShape()
Dim shp as string

shp=Activecell .Shape.name
shp=copy
Application.Goto Sheets("Blad7").Range("B2")
ActiveSheet.Paste

End Sub

 

[haseft]

[I forgot to mention that the following codes do not work.]

Hi!

In activecell there is a shape.
I want to get its name and copy it to another sheet.

Please help.

Sub CopyShape()
Dim shp as string

shp=Activecell .Shape.name
shp=copy
Application.Goto Sheets("Blad7").Range("B2")
ActiveSheet.Paste

End Sub[/QUOTE]

 

[RobMG]

Public Sub CopyAndPasteShape()


    With "Your Sheet1 Object"
    
        .Shapes("Shape Name").Copy
        
    End With
    
    With "Your Sheet2 Object"
    
        .Paste Destination:=.Range("Cell Reference")
        
    End With


End Sub

 

[haseft]

Hi

The problem is that I do not know the name of the shape in active cell.
I know in cell D28 is a shape, but don't know the name.

Public Sub CopyAndPasteShape()
Worksheets("Blad1").Activate
 Range ("D28").Select
 With Worksheets("Blad1")
       .Shapes("Shape Name").Copy
    End With
    
    With Worksheets("Process")
        .Paste Destination:=.Range("D1")
    End With
End Sub

 

[RobMG]

Ok, you don't need to activate or select an object before you use it and I would try to avoid doing so unless you have a good reason.

Why don't you know the name of the shape?

Thanks.

 

[haseft]

I pasted a word document and organizing it to a sheet.
There are many shapes in it.
For ex. I look up for a text "mytext" and then select Activecell.Offset.(1,0), there is a shape in this cell, witch I want to copy it to an other sheet.

 

[Rick Rothstein]

Place this function in the same General Module as your macro and then, when you need the name of the shape located above (shapes are above, not in, cells) the active cell, simply call it...

ShapeName = ShapeAtActiveCell

or you can use it directly in your Shapes object call...

.Shapes(ShapeAtActiveCell).Copy

Here is the code for the function...

Function ShapeAtActiveCell() As String
  Dim Sh As Shape
  For Each Sh In ActiveSheet.Shapes
    If Sh.TopLeftCell.Address = ActiveCell.Address Then
      ShapeAtActiveCell = Sh.Name
      Exit Function
    End If
  Next
End Function

 

[haseft]

Hi Rick!
Still not working.

Public Sub CopyAndPasteShape()

Worksheets("Blad1").Activate
    With Worksheets("Blad1")
       .Shapes(ShapeAtActiveCell).Copy
    End With
    
    With Worksheets("Process")
        .Paste Destination:=.Range("D1")
    End With

End Sub

 

[haseft]

Thanks Rick and RobMG.
Nu its working perfect.
I forgot to paste the function ShapeAtActiveCell.
Thanks a lot.

 

[Rick Rothstein]

Hi Rick!
Still not working.

Public Sub CopyAndPasteShape()

Worksheets("Blad1").Activate
    With Worksheets("Blad1")
       .Shapes(ShapeAtActiveCell).Copy
    End With
    
    With Worksheets("Process")
        .Paste Destination:=.Range("D1")
    End With

End Sub

Actually, I just read what you said you wanted in Message #1 and realized your code is structured incorrectly. To get the name of the shape over the active cell on the Brad1 sheet placed in cell D1 on the Process worksheet, try using this code (with my function from Message #7 installed)...

Public Sub CopyAndPasteShape()
 
  Worksheets("Blad1").Activate
  Worksheets("Process").Range("D1").Value = ShapeAtActiveCell

End Sub