CODEWITHSUNDEEP
vbaexcelshapes
Yigit Tanverdi
Yigit Tanverdi

Reputation: 161

copying and pasting a shape to another sheet and make it adjust to the cell size

I have a Problem by copying and pasting a shape in same Excel File.

I have two Sheets in one Excel file,in sheet "Tabelle 1" there is only one Picture, which i assume automatically gets the Name as "Picture 1". I would like to copy this Picture and paste it to a sheet called "Overview" which is in same Excel file with "Tabelle 1". I would like to Pasted this Picture to cell A1 and i want it to be fit to the cell size and be not bigger then the cell A1.

How can i do this ?

Upvotes: 0

Views: 3904

Answers (2)

gizlmo
gizlmo

Reputation: 1922

Dim pasteCell As Range

Set pasteCell = Sheets("Overview").Range("A1")

Sheets("Tabelle1").Shapes("Picture1").Copy
Sheets("Overview").Paste pasteCell

Sheets("Overview").Shapes(1).Height = pasteCell.Height
Sheets("Overview").Shapes(1).Width = pasteCell.Width

Assuming there is no image on the overview sheet.

Upvotes: 1

Patrick Lepelletier
Patrick Lepelletier

Reputation: 1654

Option Explicit

Sub Copy_Shape()

Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim PasteCell As Range
Dim Pic1 As Shape
Dim Pic2 As Shape

With ThisWorkbook
    Set Sh1 = .Sheets("Tabelle 1")
    Set Sh2 = .Sheets("Overview")
End With


Set Pic1 = Sh1.Shapes("Picture 1")

Pic1.Copy

With Sh2
    .Paste
    Set Pic2 = .Shapes(.Shapes.Count)
    Set PasteCell = .Cells(1, 1)
End With

With Pic2
    .Height = PasteCell.Height
    .Width = PasteCell.Width
    .Top = PasteCell.Top
    .Left = PasteCell.Left
End With

Set Pic1 = Nothing
Set Pic2 = Nothing
Set PasteCell = Nothing
Set Sh1 = Nothing
Set Sh2 = Nothing

End Sub

If you are new to VBA this is a good first exercice to practice.

Upvotes: 0

Related Questions