Copy shape object from one seet to another workbook sheet

I am trying to copy all the sheet to another workbook. My problem is that I can copy the cells but not shapes. One ways is to switch between worksbooks to copy individual shape object but in this way location of copied shape changes. I have tried like:

However, I needs to use Shapes.Range(Array(....)) for my solution so that I can copy all the shpaes or with the name Req: #.  Please note that the shape is an Oledb Object
   
Dim Destwb As Workbook
   Dim Sourcewb As Workbook
    Set Sourcewb = ActiveWorkbook
    Workbooks.Add
    Set Destwb = ActiveWorkbook
   Sourcewb.Worksheets("Sheet1").Columns("A:Z").Copy  Destination:=Destwb.Worksheets("Sheet1").Range("A1")
    
    For Each shp In Worksheets("Sheets1").Shapes
        If shp.Name Like "Reqt:" & "#*" Then 
            shp.Copy
            Destwb.Sheets(1).Activate
            Destwb.Sheets(1).Paste
            Sourcewb.Worksheets("Sheets1").Activate
        End If
    Next shp

Open in new window

fmuftiAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rory ArchibaldCommented:
I think you mean OLE object since OLEDB is a data access technology.
Is there a reason for not simply copying the actual sheets? Or even just saving the workbook with a new name if you are copying all the sheets?
0
fmuftiAuthor Commented:
I am fine with copying all the sheet if that works. Could you please post the code so that I can try if that works for me.  Also you are right its OLE object not OLE DB, as I use the same code that you posted for my another question of attaching embedded object to a cell.

However, I would still prefer copying shapes options too as I do not want to copy all the macros and stuff.

Thanks,

0
Rory ArchibaldCommented:
You can copy the sheet using code like this:


activeworkbook.sheets("Sheet1").copy after:=Workbooks("otherworkbook.xls").Sheets(1)

Open in new window

0
Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

fmuftiAuthor Commented:
Hmmmm,

I am actually emailing a copy of the spreadsheet and few other actions so I still would like to copy the shapes to the other sheet. Could you please post a code to copy shapes or modify the code that I posted to copy all the shapes with Name Like "Req:" & "#*"  in an array.
 
I'll appreciate that.

Thanks.
0
Rory ArchibaldCommented:
I don't follow - the code I posted will copy the entire sheet to the new workbook - does that not satisfy your purpose of emailing the worksheet?
0
fmuftiAuthor Commented:
The macros in the email system are blocked so I just need to mail the sheet with no macros and that is possible if I copy the data and shapes and no macro, while whole sheet means all the stuff which I do not want to transfer.

Could you please show me the code for copying shapes ?
Thanks,
0
fmuftiAuthor Commented:
The copying methods has not worked for me becuase I have protection, number of sheets, locked cells and macors. So I need to copy only the data from sheet1 and the OLEojects to a new worksheet's sheet1.

I hope I am a lot clearer in my requirement now.
0
Rory ArchibaldCommented:
OK, here's an example of code to copy sheet data and oleobjects:

Sub CopyDataAndObjects()
    Dim wksSource As Worksheet, wksDest As Worksheet
    Dim objOLE As OLEObject
    
    Set wksSource = Workbooks("Book1").Sheets(1)
    Set wksDest = ActiveWorkbook.Sheets(1)
    
    wksSource.UsedRange.Copy
    wksDest.Range("A1").PasteSpecial xlPasteAll
    For Each objOLE In wksSource.OLEObjects
        objOLE.Copy
        With wksDest
            .Activate
            .Range(objOLE.TopLeftCell.Address).Select
            .Paste
        End With
    Next objOLE
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
fmuftiAuthor Commented:
There seems be a problem that the objectect is attached one cell lower than it is in the original sheet. For exampel it the object is in cell A10, the TopLeftCell picks that cell but is placed at A11 cell in the destination sheet. Any idea what going wrong ? or how to subtract one row up.
0
Rory ArchibaldCommented:
Which version of Excel are you using? I didn't see that in my tests.
0
fmuftiAuthor Commented:
The code works for test case in my verion of Excel 2003 but my particular sheet there seems to be a weird issue as Paste does not work well but PasteSpecial does. In the end I did not use UsedRange and only did seet copying like that
 Sourcewb.Worksheets("Sheet1").Columns("A:Z").Copy  Destination:=Destwb.Worksheets("Sheet1").Range("A1")
 and used your object past code and that works fine.
However,
wksSource.UsedRange.Copy
wksDest.Range("A1").PasteSpecial xlPasteAll

does not seems to work well.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.