asked on

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

Rory Archibald

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?

fmufti

ASKER

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,

Rory Archibald

You can copy the sheet using code like this:

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

Open in new window

fmufti

ASKER

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.

Rory Archibald

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?

fmufti

ASKER

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,

fmufti

ASKER

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.

ASKER CERTIFIED SOLUTION

Rory Archibald

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

fmufti

ASKER

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.

Rory Archibald

Which version of Excel are you using? I didn't see that in my tests.

fmufti

ASKER

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.