Copy Paste Shapes to Different Worksheets Loop

[dj44]

Hi folks,

I have a list of shapes i need to copy and paste to different worksheets,
I just cant seem to get it right.

In Column A I have put the worksheet name
Column B Shape Name

Example

Worksheet ---- Shape Name
Jan ------- ShapeX
Feb--------- ShapeY


I would like to copy the shapes to the correct worksheet. these are basic shapes like rectangles

Sub CopyPasteShape()

   Dim wsh        As Worksheet
    Dim oDest     As Worksheet
    
    Dim i      As Integer
    Dim oShape As Shape
    
    oDest = wsh.Cells(i, "A").Value2
    
    Set wsh = Worksheets("Shapes")
    For i = 3 To wsh.Cells(wsh.Rows.Count, "A").End(xlUp).Row
    
    
    Set oShape = wsh.Shapes(wsh.Cells(i, "B").Value2).Copy
    
    oShape = wsh.Shapes(wsh.Cells(i, "B").Value2).Copy
    wsh.Cells(i, "A").Value2.Paste
    
   
    Next i
   
End Sub

I dont know how to make the syntax correct,

thanks for helping

dj

[Kenneth Hobs]

Sub CopyPasteShapes()    
  Dim wsh As Worksheet, oDest As Worksheet
    Dim i As Long, oShape As Shape, oShape2 As Shape
     
    'On Error Resume Next
    Set wsh = Worksheets("Shapes")
    
    For i = 3 To wsh.Cells(wsh.Rows.Count, "A").End(xlUp).Row
      Set oDest = Worksheets(wsh.Cells(i, "A").Value2)
      Set oShape = wsh.Shapes(wsh.Cells(i, "B").Value2)
      oShape.Copy
      oDest.Paste
      Application.CutCopyMode = False
      Set oShape2 = oDest.Shapes(oDest.Shapes.Count)
      With oDest.Range("A" & i)
        oShape2.Top = .Top
        oShape2.Left = .Left
        oDest.Activate
        .Select
        wsh.Select
      End With
    Next i
End Sub

[dj44]

Thank you very much Kenneth,

this worked a treat!

Really appreciate the help

dj