PPT: Sample Code to Copy Slides to Another Presentation

   Sub SlideCopy()

      ' Variable declarations.
      Dim SourceView, answer As Integer
      Dim SourceSlides, NumPres, x As Long

      ' Count the open presentations.
      NumPres = Presentations.Count

      ' Check to see whether more than one presentation is open.
      If NumPres = 0 Then
         ' If no presentations are open, stop the macro.
         MsgBox "You must have at least one presentation open", _
            vbCritical + vbOKOnly, "No Presentations Open"
         End
      End If

      ' If more than two presentations are open, quit the macro.
      If NumPres > 2 Then
         MsgBox "Too many open presentations. Only two presentations" _
            & " may be open." & Chr(13) & "The active presentation is " _
            & "the source and other presentation is the destination.", _
            vbOKOnly + vbCritical, "Too Many Open Presentations"
         End
      End If

      ' Stores the current view of the source presentation.
      SourceView = ActiveWindow.ViewType

      ' Count the number of slides in source presentation.
      SourceSlides = ActivePresentation.Slides.Count

      ' See whether only one presentation is open.
      If NumPres = 1 Then
         answer = MsgBox("Only one presentation is open. " & _
            "This presentation will be used as the source. " & _
            Chr(13) & "Press YES to create a new presentation as " _
            & "the destination.", vbYesNo + vbQuestion, "Only One " _
            & "Presentation Open")

         ' If no selected in the message box, quit the macro.
         If answer = vbNo Then
            End
         End If

         ' Create a new presentation for the designation.
         Presentations.Add

         ' Set up the slide size to be the same as the source.
         With ActivePresentation.PageSetup
            .SlideHeight = Presentations(1).PageSetup.SlideHeight
            .SlideWidth = Presentations(1).PageSetup.SlideWidth
         End With

         ' Switch the destination presentation to slide view.
         If ActiveWindow.ViewType <> ppViewSlide Then
            ActiveWindow.ViewType = ppViewSlide
         End If

         ' Switch to the source presentation.
         Presentations(1).Windows(1).Activate

      End If

      ' Change the view to slide sorter if not there already.
      If ActiveWindow.ViewType <> ppViewSlideSorter Then
         ActiveWindow.ViewType = ppViewSlideSorter
      End If

      ' Loop through all the slides and copy them to destination one by
      ' one.
      For x = 1 To SourceSlides
         ' Select the first slide in the presentation and copy it.
         ActivePresentation.Slides.Range(Array(x)).Select
         ActiveWindow.Selection.Copy

         ' Switch to destination presentation.
         Presentations(2).Windows(1).Activate

         ' Create a new slide.
         ActivePresentation.Slides.Add _
            ActivePresentation.Slides.Count + 1, ppLayoutBlank

         ' Make sure the new presentation is slide view.
         If ActiveWindow.ViewType <> ppViewSlide Then
            ActiveWindow.ViewType = ppViewSlide
         End If

         ' Switch to the proper slide.
         ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Count

         ' Paste the slide.
         ActiveWindow.View.Paste

         ' Adjust the size of the pasted object.
         With ActiveWindow.Selection.ShapeRange
            .Left = 0
            .Top = 0
            .Width = ActivePresentation.PageSetup.SlideWidth
            .Height = ActivePresentation.PageSetup.SlideHeight
         End With

         ' Unselect the object.
         ActiveWindow.Selection.Unselect

         ' Switch to source.
         Presentations(1).Windows(1).Activate

      Next x

      ' Restore the current view to source.
      ActiveWindow.ViewType = SourceView

   End Sub