Copy a picture, paste to another worksheet and resize the picture

We may store pictures in the worksheet and want to use the picture for another purpose. To do so, the picture has to be copied and pasted to the needed position by attaching to a cell. The picture needed to be resized. This page discussed a short and simple procedure to copy a picture, paste to another worksheet and resize it.

1. Clean the worksheet to remove the existing shape of the same name.

Delete the picture which is already existing with the same name by looping through all the shapes to find the shape of the same name. Us the For Each ... Next structure.

Option Explicit
Option Base 1
Option Compare Text
Sub CopyPasteResizePicture()
    Dim FrWs As String, FrPic As String, ToWs As String
    Dim r As Long, c As Long, rs As Long, cs As Long
    
    Application.ScreenUpdating = False
'******************************************************
'Input data
'******************************************************
    FrWs = "ch3 measurement" 'The name of worksheet where the master picture resides
    FrPic = "Picture 3-1" 'The name of the picture
    ToWs = "Sheet1" 'The name of worksheet where the picture is pasted and attached to a cell
    r = 1 'The row of the top left cell for the picture
    c = 1 Sub CopyPasteResizePicture()
    Dim FrWs As String, FrPic As String, ToWs As String
    Dim r As Long, c As Long, rs As Long, cs As Long
    
    Application.ScreenUpdating = False
'*************************************************************
'Input data
'*************************************************************
    FrWs = "ch3 measurement" 'The name of worksheet where the master picture resides
    FrPic = "Picture 3-1" 'The name of the picture
    ToWs = "Sheet1" 'The name of worksheet where the picture is pasted and attached to a cell
    r = 1 'The row of the top left cell
    c = 1 'The column of the top left cell
    rs = 2 'The number of rows, representing the height of the picture
    cs = 2 'The number of columns, representing the width of the picture
	
'*************************************************************
'Delete an existing shape of the same name.
'************************************************************
    For Each sh In Worksheets(ToWs).Shapes
        If sh.Name = FrPic Then
            sh.Delete
        End If
    Next
			

2. Copy a picture and paste to another worksheet.

Picture is copied and pasted to another worksheet using the Copy and Paste method.

'**************************************************************
'Copy and Paste
'Bear in mind that ThisWorkBook Object is used to include the case
' where the picture is stored in the worksheet of Excel Addin.
'**************************************************************
    ThisWorkbook.Worksheets(FrWs).Pictures(FrPic).Copy
    ActiveWorkbook.Worksheets(ToWs).Paste
			

3. Position and resize the picture.

The picture is attached to a cell and sit in the range using the Left, Top, Width, and Height properties.
Teh picture is resized autmatically at the same Aspect Ratio. In order to resize to the height and width as given, use the LockAspectRatio = msoFalse statement.

'**************************************************************
'Reposition and resize the picture
'**************************************************************
    With Selection
        .ShapeRange.LockAspectRatio = msoFalse
        .Left = Cells(r, c).Left
        .Top = Cells(r, c).Top
        .Width = Cells(r, c).Resize(1, cs).Width
        .Height = Cells(r, c).Resize(rs, 1).Height
    End With
    Application.CutCopyMode = False
End SubThe 
			

4. Download open-source workbook

Download Excel workbook with open-source code

---

Dated on: 19 November 2019