copying the objects from a sheet

[Michelle]

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

 

[joel]

why not create a tempalte worksheet and just copy the template when yo
start a new worksheet. The template can either be a sheet in th
workbook or in a seperate workbook.

 

[Peter T]

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]

Peter - that is BRILLIANT!

Thank you

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

 

[Peter T]

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