Copy and Replace Excel Table to PowerPoint Table data

[Chendra]

Hi Everyone,

I have an Excel Sheet which contains a range of values as Table, I want to copy those values and replace them in the PowerPoint table(which is the same range as source table). My slide may contain one or more tables so I will identify them using table name, Below is the code which I tried. Please tell me how to go further. I am attaching input and output tables also please have a look. Thanks In Advance.

<
Option Explicit
Sub ExceltoPPT()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim InputFolder As String, FileName As Range, SheetName As String
Dim SlideNumber As Integer, ChartName As String, CopyRange As String, PasteRange As String

Dim ObjPPT As PowerPoint.Application
Dim ObjPresentation As PowerPoint.Presentation
Dim ObjSlide As PowerPoint.Slide
Dim myTable As PowerPoint.Table
Dim mychart As PowerPoint.Chart
Dim pptWkBk As Workbook, wkbSource As Workbook
Dim pptWSheet As Worksheet, strPath As String
Dim MainWorkbook As String, DestinationPPT As String


Set ObjPPT = CreateObject("PowerPoint.Application")
DestinationPPT = "path" & "sample.pptm"
Set ObjPresentation = ObjPPT.Presentations.Open(DestinationPPT)

strPath = ThisWorkbook.Sheets("Control").Range("InputFolder").Value
For Each FileName In ThisWorkbook.Sheets("Control").Range("File_Name")
' Get variables from Code Sheet
SheetName = FileName.Offset(0, 1).Value
SlideNumber = FileName.Offset(0, 2).Value
ChartName = FileName.Offset(0, 3).Value
CopyRange = FileName.Offset(0, 4).Value
PasteRange = FileName.Offset(0, 5).Value
'Open Source Workbook
Set wkbSource = Workbooks.Open(strPath & FileName)

Set ObjSlide = ObjPresentation.Slides(SlideNumber)
wkbSource.Sheets(SheetName).Range(CopyRange).Copy
'ObjSlide.Shapes.PasteSpecial DataType:=ppPasteDefault
'Set myTable = ObjSlide.Shapes(ObjSlide.Shapes.Count)
ObjSlide.Shapes.PasteSpecial DataType:=ppPasteHTML, Link:=msoFalse

wkbSource.Close
Set wkbSource = Nothing


Next FileName

Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox ("Done")
End Sub



>