CODEWITHSUNDEEP
imagevbaexcel
Nina Nuckols
Nina Nuckols

Reputation: 11

Copying multiple images from one workbook to another as separate images

In 2003 the code worked perfectly, we just updated to 2010 and its affecting our outgoing proposals.

I've been looking on multiple sites and everything i have tried gives me all the pictures pasted into one grouped image OR gives me multiple boxes that say image cannot be viewed.

The pictures will always be located in column L, but it can be one picture or 50 and even none. So i need to be able to select all images, copy and open another workbook and paste in a designated column with the same format and as separate images, not as a single image which is what I am getting right now. Any help would be greatly appreciated. Below is the latest code I have tried, still getting a "single grouped image" when pasting.

Windows(ourName2).Activate
Sheets("Sheet5").Select
On Error Resume Next
ActiveSheet.Pictures.Copy
Windows("Proposal.xls").Activate
Sheets("Sheet2").Select
ActiveSheet.PasteSpecial Range("L7")

Update, attempting to use this code raises error on the line Set wbSource = Workbooks("ourName2")

Dim wbSource As Workbook 
Dim wbDest As Workbook 
Dim shSource As Worksheet 
Dim shDest As Worksheet 
Dim shp As Shape 

Set wbSource = Workbooks("ourName2") 'modify as needed   
Set wbDest = Workbooks("MPlanner.xls") 'modify as needed 
Set shSource = wbSource.Sheets("Sheet5") 'modify as needed 
Set shDest = wbDest.Sheets("MAudit") 'modify as needed 

shSource.Pictures.Copy shDest.Range("L7").Paste

Upvotes: 1

Views: 3343

Answers (2)

David Zemens
David Zemens

Reputation: 53623

Echoing Tim, this worked for me, resulting in non-grouped pictures. There should not be any reason you need to Activate the respective sheets.

The problem seems to be that you were using PasteSpecial method instead of Paste. I have a 2003 box at home I could verify on, but on 2010 Excel, the PasteSpecial method pasts the multiple pictures as a single object, whereas Paste puts them each individually.

Sub CopyAllPictures()
Dim wbSource As Workbook
Dim wbDest As Workbook
Dim shSource As Worksheet
Dim shDest As Worksheet
Dim shp As Shape

Set wbSource = Workbooks("Book12")          'modify as needed
Set wbDest = Workbooks("Book13")            'modify as needed

Set shSource = wbSource.Sheets("Sheet1")    'modify as needed
Set shDest = wbDest.Sheets("Sheet1")        'modify as needed

shSource.Pictures.Copy
shDest.Range("L7").Paste


End Sub

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166196

This worked for me:

Sub test()
    ActiveSheet.Pictures.Copy
    With Workbooks("temp.xls").Sheets("Sheet1")
        .Parent.Activate
        .Activate
        .Range("L7").Select
        .Paste
    End With
End Sub

Upvotes: 1

Related Questions