Copy table from Excel to PowerPoint VBA - vba

Question

I'm trying to copy and paste a table consisting of shape from an Excel Sheet into a PowerPoint slide using VBA keeping its source formatting [].
I want to write directly on the tale on the slide after paste. Everything seems to work fine except the shape was not pasted into the table [].
Sub CreatePP()
Dim ppapp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Dim ppTextBox As PowerPoint.Shape
Dim iLastRowReport As Integer
Dim sh As Object
Dim templatePath As String
On Error Resume Next
Set ppapp = GetObject(, "PowerPoint.Application")
On Error GoTo 0
'Let's create a new PowerPoint
If ppapp Is Nothing Then
Set ppapp = New PowerPoint.Application
End If
'Make a presentation in PowerPoint
If ppapp.Presentations.Count = 0 Then
Set ppPres = ppapp.Presentations.Add
ppPres.ApplyTemplate "C:\Users\luunt1\AppData\Roaming\Microsoft\Templates\Document Themes\themevpb.thmx"
End If
'Show the PowerPoint
ppapp.Visible = True
For Each sh In ThisWorkbook.Sheets
If sh.Name Like "E_KRI" Then
ppapp.ActivePresentation.Slides.Add ppapp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
ppapp.ActiveWindow.View.GotoSlide ppapp.ActivePresentation.Slides.Count
Set ppSlide = ppapp.ActivePresentation.Slides(ppapp.ActivePresentation.Slides.Count)
ppSlide.Select
iLastRowReport = Range("B" & Rows.Count).End(xlUp).Row
Range("A1:J" & iLastRowReport).Copy
DoEvents
ppapp.CommandBars.ExecuteMso ("PasteExcelTableSourceFormatting")
Wait 3
With ppapp.ActiveWindow.Selection.ShapeRange
.Width = 700
.Left = 10
.Top = 75
.ZOrder msoSendToBack
End With
Selection.Font.Size = 12
'On Error GoTo NoFileSelected
AppActivate ("Microsoft PowerPoint")
Set ppSlide = Nothing
Set ppapp = Nothing
End If
Next
End Sub
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub

Answer 1

Rather than selecting the range of the table and pasting, it may solve your solution to instead paste the table object itself, so:
ActiveSheet.ListObjects(1).Copy 'Assuming it is the only table on the sheet. Adjust this code as needed for your specific case