Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cell As Range
For Each cell In Selection
ActiveSheet.Shapes("Rectangle 1").Copy
cell.Select
ActiveSheet.Paste
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
.Height = .TopLeftCell.Height
.Width = .TopLeftCell.Width
End With
Next
End Sub