Download Sample Workbook

Sub TransferDefinedDataRangeFromExcelToPPT()
'Defined the Stat Tab
Dim Sh As Worksheet
Set Sh = ActiveWorkbook.Sheets("Stat")
'Define the PowerPoint application
Dim PPTApp As PowerPoint.Application
Set PPTApp = New PowerPoint.Application
'Define the Presentation in the Powerpoint App
Dim PPTPres As PowerPoint.Presentation
Set PPTPres = PPTApp.Presentations.Add
'visible the PPT Presentation
PPTApp.Visible = True
'Define and Add one slide to PowerPoint
Dim PPTSlide As PowerPoint.Slide
Set PPTSlide = PPTPres.Slides.Add(1, ppLayoutBlank)
'copy the Data Range from Stat Tab
Sh.Activate
Sh.Range("E3:K19").Copy
'Paste the Copied data into PPT Slide
With PPTSlide.Shapes.Paste
.Top = 50
.Height = 450
.Width = 720
.Left = 150
End With
Application.CutCopyMode = xlCopy
End Sub