I didn't understand what you meant!

Try

Sub ImportABunch()
' based on code from pptfaq

Dim SW As Long
Dim SH As Long
Dim strTemp As String
Dim strPath As String
Dim strFileSpec As String
Dim oSld As Slide
Dim oPic As Shape
Dim iCount As Integer
Dim lngStart As Long
On Error GoTo err
'++++++++++++++++++++++++++++++NEW
If ActivePresentation.Slides.Count > 1 Then _
ActivePresentation.Slides(2).Shapes.Range.Copy
'++++++++++++++++++++++++++++++NEW
' Edit these to suit:
strPath = "c:\Users\John\Desktop\Pics\"
strFileSpec = "*.png"
SH = ActivePresentation.PageSetup.SlideHeight
SW = ActivePresentation.PageSetup.SlideWidth
strTemp = Dir(strPath & strFileSpec)
lngStart = ActiveWindow.Selection.SlideRange(1).SlideIndex
Do While strTemp <> ""
Set oSld = ActivePresentation.Slides.Add _
(lngStart + 1, ppLayoutBlank)
lngStart = lngStart + 1
iCount = iCount + 1
Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strTemp, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0, _
Width:=msoTrue, _
Height:=msoTrue)

'reset height to a 150points less than slide height
With oPic
.LockAspectRatio = msoTrue
.Height = SH - 150
.Left = (SW - oPic.Width) / 2
.Top = 100
End With
' Get the next file that meets the spec and go round again

'=========================NEW
oSld.Shapes.Paste
'=========================NEW
strTemp = Dir
Loop
If MsgBox("I added " & iCount & " Images." & vbCrLf & "Would you like to delete the files? This cannot be reversed.", vbYesNo) = vbYes Then
Kill strPath & "*png"""
End If
Exit Sub
err:
MsgBox "There's an error"
End Sub

__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials