PowerPoint VBA, "For each" troubleshooting help (with copy pasting)

Question

I'm trying to do a loop which would copy shape and then paste it to the following slide.

I have 20 Slides in which 19 of them have a Shape (group of shape actually, textbox, imgs etc..) at the coordinates .Left = AA and .Top = BB.

    Dim Sld As Slide
    Dim Shp As Shape

For Each Shp In Sld.Shapes
        With Shp
            If .Type = msoGroup _
                And .Left = AA _
                And .Top = BB _
                Then
                    .Cut

                With ActivePresentation.Slides(ActiveWindow.Selection.SlideRange.SlideIndex + 1)
                    .Shapes.Paste
                    .Left = CC
                    .Top = DD
                End With
            End If
        End With
    Next
Next Sld

This is my current code, and the probleme I have is that It will cut and paste all the shapes, but not in the next slide following the slide where the Shape was first copied.

It will paste them all in following slide of where I was when I run the macro.

For exemple If I'm on slide 4 and I run the macro, all the shapes in .Left = AA and .Top = BB will be pasted in Slide 5 at .Left = CC and .Top = DD

What I would like is If the shape is cut in slide 1, I would like it pasted in slide 2 at .left = CC and .Top = DD. If the shape is in slide 2, I would like it pasted in Slide 3 at .left = CC and .Top = DD. And so on.

Thank you in advance for your help. I've been stuck on this for over a week.

Answer 1

The following cuts and pastes the shapes and repositions them - starting from the next to last slide so as not to cut a shape that was just pasted:

Sub MyTestSub()
    Const OLD_DISTANCE_A As Long = 10
    Const OLD_DISTANCE_B As Long = 10
    Const NEW_DISTANCE_C As Long = 100
    Const NEW_DISTANCE_D As Long = 100

    Dim oSld As Slide
    Dim oShp As Shape
    Dim oShpRng As ShapeRange
    Dim lCurrentSlideIndex As Long

    '***** go through all slides except the last one - start from the next to last
    For lCurrentSlideIndex = ActivePresentation.Slides.Count - 1 To 1 Step -1
        Set oSld = ActivePresentation.Slides(lCurrentSlideIndex)

        For Each oShp In oSld.Shapes
            '***** is it in the position we are interested in?
            If oShp.Left = OLD_DISTANCE_A And oShp.Top = OLD_DISTANCE_B Then
                oShp.Cut

                '***** paste on slide + 1 (without checking that it exists!)
                Set oShpRng = ActivePresentation.Slides(oSld.SlideIndex + 1).Shapes.Paste

                '***** set new position
                oShpRng.Left = NEW_DISTANCE_C
                oShpRng.Top = NEW_DISTANCE_D
            End If
        Next oShp
    Next lCurrentSlideIndex
End Sub

Answer 2

Does this working (tested) example help?

Option Explicit

Const AA = 0
Const BB = 0
Const CC = 100
Const DD = 100

Sub MoveShapesBetweenSlides()
  Dim Sld As Slide
  Dim Shp As Shape
  For Each Sld In ActivePresentation.Slides
    For Each Shp In Sld.Shapes
      With Shp
        If .Type = msoGroup And .Left = AA And .Top = BB Then
          .Cut
          ' Create an index to the next slide
          Dim lNextSld As Long
          If Sld.SlideIndex = ActivePresentation.Slides.Count Then
            lNextSld = 1
          Else
            lNextSld = Sld.SlideIndex + 1
          End If
          ' Paste the shape from the previous slide to the next slide and reposition it
          With ActivePresentation.Slides(lNextSld)
            With .Shapes.Paste
              .Left = CC
              .Top = DD
            End With
          End With
        End If
      End With
    Next Shp
  Next Sld
End Sub