I am trying to write code to copy the objects (logos, graphics, etc) from
one sheet to another, and have them come up in the same place on the
destination sheet.

At the moment, it's putting them somewhere near but not quite at the top of
the sheet and shifting them left a bit

Is there a way to get them to go in the same place?

Here's the code that isn't working:
Sheets("Sheet1").Select
ActiveSheet.DrawingObjects.Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.PasteSpecial Format:="MS Office Drawing Object",
Link:=False, _
DisplayAsIcon:=False
'=====================

Thanks

M

Things work slightly differently in 97-2003 and later versions. This isn't
optimal for either but should work in both (but note the ActiveX caveat)

Sub test1()
Dim i As Long, j As Long, first As Long
Dim sAddr As String
Dim shtOrig As Object
Dim dwOb As Object
Dim dwObs As Object

' don't use this if ActiveX controls being copied

Set dwObs = Worksheets("Sheet1").DrawingObjects
If dwObs.Count = 0 Then Exit Sub

dwObs.Copy

Worksheets("Sheet2").Paste

With Worksheets("Sheet2").DrawingObjects

For i = .Count - dwObs.Count + 1 To .Count
j = j + 1
With .Item(i)
.Left = dwObs(j).Left
.Top = dwObs(j).Top
End With
Next

End With

' optional deselect the objects
' Worksheets("Sheet2").Activate
' ActiveCell.Select

End Sub

Regards,
Peter T


"Michelle" <(E-Mail Removed)> wrote in message
news:F28F291E-9806-4B6D-A34E-(E-Mail Removed)...
>I am trying to write code to copy the objects (logos, graphics, etc) from
>one sheet to another, and have them come up in the same place on the
>destination sheet.
>
> At the moment, it's putting them somewhere near but not quite at the top
> of the sheet and shifting them left a bit
>
> Is there a way to get them to go in the same place?
>
> Here's the code that isn't working:
> Sheets("Sheet1").Select
> ActiveSheet.DrawingObjects.Select
> Selection.Copy
> Sheets("Sheet2").Select
> ActiveSheet.PasteSpecial Format:="MS Office Drawing Object",
> Link:=False, _
> DisplayAsIcon:=False
> '=====================
>
> Thanks
>
> M

Peter - that is BRILLIANT!

Thank you

M


"Peter T" <peter_t@discussions> wrote in message
news:(E-Mail Removed)...
> Things work slightly differently in 97-2003 and later versions. This isn't
> optimal for either but should work in both (but note the ActiveX caveat)
>
> Sub test1()
> Dim i As Long, j As Long, first As Long
> Dim sAddr As String
> Dim shtOrig As Object
> Dim dwOb As Object
> Dim dwObs As Object
>
> ' don't use this if ActiveX controls being copied
>
> Set dwObs = Worksheets("Sheet1").DrawingObjects
> If dwObs.Count = 0 Then Exit Sub
>
> dwObs.Copy
>
> Worksheets("Sheet2").Paste
>
> With Worksheets("Sheet2").DrawingObjects
>
> For i = .Count - dwObs.Count + 1 To .Count
> j = j + 1
> With .Item(i)
> .Left = dwObs(j).Left
> .Top = dwObs(j).Top
> End With
> Next
>
> End With
>
> ' optional deselect the objects
> ' Worksheets("Sheet2").Activate
> ' ActiveCell.Select
>
> End Sub
>
> Regards,
> Peter T
>
>
> "Michelle" <(E-Mail Removed)> wrote in message
> news:F28F291E-9806-4B6D-A34E-(E-Mail Removed)...
>>I am trying to write code to copy the objects (logos, graphics, etc) from
>>one sheet to another, and have them come up in the same place on the
>>destination sheet.
>>
>> At the moment, it's putting them somewhere near but not quite at the top
>> of the sheet and shifting them left a bit
>>
>> Is there a way to get them to go in the same place?
>>
>> Here's the code that isn't working:
>> Sheets("Sheet1").Select
>> ActiveSheet.DrawingObjects.Select
>> Selection.Copy
>> Sheets("Sheet2").Select
>> ActiveSheet.PasteSpecial Format:="MS Office Drawing Object",
>> Link:=False, _
>> DisplayAsIcon:=False
>> '=====================
>>
>> Thanks
>>
>> M
>
>

That's nice, glad it worked :-)

I see there are some unused variable declarations you can get rid of (that
I'd used in earlier testing)

Regards,
Peter T


"Michelle" <(E-Mail Removed)> wrote in message
news:2B2DFFB9-2DAD-4851-80F6-(E-Mail Removed)...
> Peter - that is BRILLIANT!
>
> Thank you
>
> M
>
>
> "Peter T" <peter_t@discussions> wrote in message
> news:(E-Mail Removed)...
>> Things work slightly differently in 97-2003 and later versions. This
>> isn't optimal for either but should work in both (but note the ActiveX
>> caveat)
>>
>> Sub test1()
>> Dim i As Long, j As Long, first As Long
>> Dim sAddr As String
>> Dim shtOrig As Object
>> Dim dwOb As Object
>> Dim dwObs As Object
>>
>> ' don't use this if ActiveX controls being copied
>>
>> Set dwObs = Worksheets("Sheet1").DrawingObjects
>> If dwObs.Count = 0 Then Exit Sub
>>
>> dwObs.Copy
>>
>> Worksheets("Sheet2").Paste
>>
>> With Worksheets("Sheet2").DrawingObjects
>>
>> For i = .Count - dwObs.Count + 1 To .Count
>> j = j + 1
>> With .Item(i)
>> .Left = dwObs(j).Left
>> .Top = dwObs(j).Top
>> End With
>> Next
>>
>> End With
>>
>> ' optional deselect the objects
>> ' Worksheets("Sheet2").Activate
>> ' ActiveCell.Select
>>
>> End Sub
>>
>> Regards,
>> Peter T
>>
>>
>> "Michelle" <(E-Mail Removed)> wrote in message
>> news:F28F291E-9806-4B6D-A34E-(E-Mail Removed)...
>>>I am trying to write code to copy the objects (logos, graphics, etc) from
>>>one sheet to another, and have them come up in the same place on the
>>>destination sheet.
>>>
>>> At the moment, it's putting them somewhere near but not quite at the top
>>> of the sheet and shifting them left a bit
>>>
>>> Is there a way to get them to go in the same place?
>>>
>>> Here's the code that isn't working:
>>> Sheets("Sheet1").Select
>>> ActiveSheet.DrawingObjects.Select
>>> Selection.Copy
>>> Sheets("Sheet2").Select
>>> ActiveSheet.PasteSpecial Format:="MS Office Drawing Object",
>>> Link:=False, _
>>> DisplayAsIcon:=False
>>> '=====================
>>>
>>> Thanks
>>>
>>> M
>>
>>
>