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

        HansVogelaar 

        It's returning the following error because of row 

         With w2.Shapes("Picture 4")

         

Resources