locked
VBA Macro, move picture from Sheet1 to Sheet2 one by one. RRS feed

  • Question

  •   Hi, guys, I have a question.

      I wand program a Macro to move picture,  the details below:

      Multi-Picture in sheet1, by macro, Excel automatic move picture to sheet2 one by one, and assign specific placed address in macro.

      What can i do? TX.

    Tuesday, October 11, 2016 3:52 AM

Answers

  • See if below helps.

    Sub MovePic()
    
        Dim sh As Shape
        Dim rng As Range
        
        Worksheets("Sheet2").Activate
        
        For Each sh In Worksheets("Sheet1").Shapes
        
            Set rng = Application.InputBox(prompt:="Pls select the range to paste", Type:=8)
            sh.Copy
            rng.PasteSpecial xlPasteAll
        Next sh
    
    End Sub
    


    Best Regards,
    Asadulla Javed,
    Jadavpore & Asansol

    • Marked as answer by Erbin.F Wednesday, October 12, 2016 8:22 AM
    Tuesday, October 11, 2016 4:10 PM
    Answerer

All replies

  •    THx TieBreake, the code below. I want to select cell's address(e.g A3) of Sheet2 in the Macro, so that I can expediently place piture to any position, but I do not know how to modify the code.

    Sub CopyPastePicture() Dim shp1 As Shape, shp2 As Shape Set shp1 = Worksheets("Sheet1").Shapes(1) shp1.Copy Worksheets("Sheet2").Paste With Worksheets("Sheet2").Shapes Set shp2 = .Item(.Count) End With MsgBox shp2.Name End Sub

    Tuesday, October 11, 2016 9:33 AM
  • re:  copy shape to another sheet

    You can copy the cells (range) that contains the shape.  The shape will be included with the cells...

      Dim rngAround As Range
      Set rngAround = Worksheets(1).Range(Worksheets(1).Shapes(1).TopLeftCell, Worksheets(1).Shapes(1).BottomRightCell)
      rngAround.Copy Destination:=Worksheets(2).Range("B22") '<<<< new location

    '---
    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2 (Dropbox)
    (free & commercial excel add-ins & workbooks)


     
    Tuesday, October 11, 2016 2:09 PM
  • See if below helps.

    Sub MovePic()
    
        Dim sh As Shape
        Dim rng As Range
        
        Worksheets("Sheet2").Activate
        
        For Each sh In Worksheets("Sheet1").Shapes
        
            Set rng = Application.InputBox(prompt:="Pls select the range to paste", Type:=8)
            sh.Copy
            rng.PasteSpecial xlPasteAll
        Next sh
    
    End Sub
    


    Best Regards,
    Asadulla Javed,
    Jadavpore & Asansol

    • Marked as answer by Erbin.F Wednesday, October 12, 2016 8:22 AM
    Tuesday, October 11, 2016 4:10 PM
    Answerer
  • It is good to see it helped. Probably the code can be updated a bit...

    When you are selecting range in Sheet2 you do not know which pic is being copied. Probably in future you may want a particular pic to be pasted in particular place. You can put a line like below.

    I used Shape name as identification. YOu can use other property of Shape object.

    Sub MovePic()
    
        Dim sh As Shape
        Dim rng As Range
        
        Worksheets("Sheet2").Activate
        
        For Each sh In Worksheets("Sheet1").Shapes
            MsgBox sh.Name & " is being copied to Sheet2"
            Set rng = Application.InputBox(prompt:="Pls select the range to paste", Type:=8)
            sh.Copy
            rng.PasteSpecial xlPasteAll
        Next sh
    
    End Sub
    


    Best Regards,
    Asadulla Javed,
    Jadavpore & Asansol

    Wednesday, October 12, 2016 10:28 AM
    Answerer