macro problem

[Kevin]

Thanks for Reply
i am copying and pasting differnetly
i have included code below

Application.ScreenUpdating = False
Dim mypic As Picture
Dim myAddr As String
Dim rDest As Range
Set mypic = ActiveSheet.Pictures(Application.Caller)

Select Case LCase(mypic.Name)
Case "picture 57", "picture 60", "picture 63", "picture
66", "picture 72", "picture 75", "picture 78", "picture 81", "picture
84", "picture 54"
myAddr = "D10"
Case Else
Exit Sub
End Select
mypic.Copy
With ThisWorkbook.Worksheets("TEMPLATE")
On Error Resume Next
.Pictures("mypicture_" & myAddr).Delete
On Error Resume Next
Set rDest = .Range(myAddr)
.Paste
With .Pictures(.Pictures.Count)
.Name = "mypicture_" & myAddr
.Top = rDest.Top
.Left = rDest.Left
End With
End With
ThisWorkbook.Worksheets("TEMPLATE").Select
Range("A1").Select
Application.ScreenUpdating = True

thanks in advance

kevin

 

[Dave Peterson]

Actually, your code is pretty much the same as Jim's code.

You use
mypic.copy
and later
ThisWorkbook.Worksheets("TEMPLATE").paste
(albeit that it's wrapped in a "with/end with" statement.

But I'm guessing you mean that the pasted picture has the same macro associated
with it.

You could get rid of that macro assignment in this section of code:

With .Pictures(.Pictures.Count)
.Name = "mypicture_" & myAddr
.Top = rDest.Top
.Left = rDest.Left
.OnAction = ""
End With

That .onaction is the added line.