SOLVED

[VBA] Copy image to workbook

Copper Contributor

Hey everyone,

 

I have an excel file with several formulas taking data from another "raw" excel file.

This excel file is basically doing all the necessary calculations and automatically putting all numbers in the right places. This first stage is done and complete.

On the next and final stage, I need to select only the relevant data (active rows) + a logo image, and copy paste it in a new "clean" workbook.

Now, I have all of this done, except the image which I'm not finding a solution to copy it so far.

 

I'm running a few statements for this in a specific order and the last one, to copy paste values, is as follows:

 

Sub CopyToNew()

ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy

Workbooks.Add

Range("A1").PasteSpecial xlPasteColumnWidths

Range("A1").PasteSpecial xlPasteValues

Range("A1").PasteSpecial xlPasteFormats

End Sub

 

Is there a way to include the copy paste of the image on the statement above or create an additional one which is compatible?

The image is somewhere between cell B112:B115 and is called "Picture 4". 

 

Thanks!

João

8 Replies
best response confirmed by Costafeller (Copper Contributor)
Solution

@Costafeller 

For example:

Sub CopyToNew()
    Dim w1 As Worksheet
    Dim wb As Workbook
    Dim w2 As Worksheet
    Set w1 = ActiveSheet
    w1.UsedRange.SpecialCells(xlCellTypeVisible).Copy
    Set wb = Workbooks.Add
    Set w2 = wb.Worksheets(1)
    w2.Range("A1").PasteSpecial xlPasteColumnWidths
    w2.Range("A1").PasteSpecial xlPasteValues
    w2.Range("A1").PasteSpecial xlPasteFormats
    w1.Shapes("Picture 4").Copy
    w2.Paste
End Sub

@Hans Vogelaar this is great thanks.

For it to be final, I just need to paste the image on a specific coordinate or cell, currently its pasting in the top left corner (A1).

 

Also, I just noticed now there was actually another image in the excel file, so I made a quick addition to what you provided me:

 

Sub CopyToNew()
    Dim w1 As Worksheet
    Dim wb As Workbook
    Dim w2 As Worksheet
    Set w1 = ActiveSheet
    w1.UsedRange.SpecialCells(xlCellTypeVisible).Copy
    Set wb = Workbooks.Add
    Set w2 = wb.Worksheets(1)
    w2.Range("A1").PasteSpecial xlPasteColumnWidths
    w2.Range("A1").PasteSpecial xlPasteValues
    w2.Range("A1").PasteSpecial xlPasteFormats
    w1.Shapes("Picture 4").Copy
    w2.Paste
    w1.Shapes("Gerade Verbindung 3").Copy
    w2.Paste
End Sub

 

@Costafeller 

I hope you can modify the following version for your situation:

Sub CopyToNew()
    Dim w1 As Worksheet
    Dim wb As Workbook
    Dim w2 As Worksheet
    Set w1 = ActiveSheet
    w1.UsedRange.SpecialCells(xlCellTypeVisible).Copy
    Set wb = Workbooks.Add
    Set w2 = wb.Worksheets(1)
    w2.Range("A1").PasteSpecial xlPasteColumnWidths
    w2.Range("A1").PasteSpecial xlPasteValues
    w2.Range("A1").PasteSpecial xlPasteFormats
    w1.Shapes("Picture 4").Copy
    w2.Paste
    With w2.Shapes("Picture 4")
        ' Change cell as needed
        .Top = w2.Range("B112").Top
        .Left = w2.Range("B112").Left
    End With
    w1.Shapes("Gerade Verbindung 3").Copy
    w2.Paste
    With w2.Shapes("Gerade Verbindung 3")
        ' Change cell as needed
        .Top = w2.Range("D75").Top
        .Left = w2.Range("D75").Left
    End With
End Sub

@Hans Vogelaar 

It's returning the following error because of row 

 With w2.Shapes("Picture 4")

Costafeller_0-1626694808375.png

 

@Costafeller 

Strange - when I tested the code, it ran without errors. The copied/pasted shapes kept the same names as the original.

@Hans Vogelaar 
So what are my options here?

@Costafeller 

Could you attach a sample workbook that demonstrates the problem?

@Hans Vogelaar 

Well this is interesting... I had to strip the file so I could share it as you've requested, because of private information, and when I finished and tested the last code it works..

I'm assuming it's something not compatible with what I had before so I'll look deeper into it, but I have no idea what might be.

 

Edit: There was some issue with the name of the image, I just changed it and it works perfectly.

Thank you so much @Hans Vogelaar! Your help was really really appreciated!

1 best response

Accepted Solutions
best response confirmed by Costafeller (Copper Contributor)
Solution

@Costafeller 

For example:

Sub CopyToNew()
    Dim w1 As Worksheet
    Dim wb As Workbook
    Dim w2 As Worksheet
    Set w1 = ActiveSheet
    w1.UsedRange.SpecialCells(xlCellTypeVisible).Copy
    Set wb = Workbooks.Add
    Set w2 = wb.Worksheets(1)
    w2.Range("A1").PasteSpecial xlPasteColumnWidths
    w2.Range("A1").PasteSpecial xlPasteValues
    w2.Range("A1").PasteSpecial xlPasteFormats
    w1.Shapes("Picture 4").Copy
    w2.Paste
End Sub

View solution in original post