Maybe (not quite sure what you mean)

Sub ExcelRangeToPowerPoint()

Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object




'Copy Range from Excel
  Set rng = Selection
  rng.Copy
'Create an Instance of PowerPoint
  On Error Resume Next


    'Is PowerPoint already opened?
      Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    
    'Clear the error between errors
      Err.Clear


    'If PowerPoint is not already open then open PowerPoint
      If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
    
    'Handle if the PowerPoint Application is not found
      If Err.Number = 429 Then
        MsgBox "PowerPoint could not be found, aborting."
        Exit Sub
      End If
  On Error GoTo 0
  Application.ScreenUpdating = False
  
  Set myPresentation = PowerPointApp.ActivePresentation
  
  Set mySlide = PowerPointApp.ActiveWindow.Selection.SlideRange(1)
  
  Dim L As Long
  If mySlide.Shapes.HasTitle Then
    For L = mySlide.Shapes.Count To 1 Step -1
  If mySlide.Shapes(L).ID <> mySlide.Shapes.Title.ID Then
  mySlide.Shapes(L).Delete
  End If
    Next L
  Else
  mySlide.Shapes.Range.Delete
  End If
'Paste to PowerPoint and position
  mySlide.Shapes.Paste
  Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
  
    'Set position:
      myShape.Left = 66
      myShape.Top = 152
' Next slide
If mySlide.slideindex < myPresentation.slides.Count Then
myPresentation.slides(mySlide.slideindex + 1).Select
End If
'Make PowerPoint Visible and Active
  PowerPointApp.Visible = True
  PowerPointApp.Activate


'Clear The Clipboard
  Application.CutCopyMode = False
 
End Sub