Forum Discussion

Costafeller's avatar
Costafeller
Copper Contributor
Jul 18, 2021
Solved

[VBA] Copy image to workbook

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

excel
Macros and VBA
  • HansVogelaar's avatar
    HansVogelaar
    Jul 18, 2021

    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

8 Replies

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Jul 18, 2021

    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
    • Costafeller's avatar
      Costafeller
      Copper Contributor
      Jul 19, 2021

      HansVogelaar 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

       

      • HansVogelaar's avatar
        HansVogelaar
        MVP
        Jul 19, 2021

        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

Resources