Copy data from all the tables in a PowerPoint presentation to Excel

If you want to copy the data from all the tables in a PowerPoint presentation to excel.

Sample Presentation

Excel Macro workbook


Here is the code-


Sub copy_ppt_excel()
' refrence select Microsoft powerpoint
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim oPS As PowerPoint.Slide
Dim Shp As Object
Dim abc As Table
Dim i As Integer, j As Integer, k As Integer, s As Integer
Set PPApp = New PowerPoint.Application

PPApp.Visible = True

' open the ppt from which u want to import the data
Set PPPres = PPApp.Presentations.Open("C:\Documents and Settings\achamanlalko\Desktop\example.ppt")
' go through all the slides
For Each oPS In PPPres.Slides

' go through all the tables in each slides
For Each Shp In oPS.Shapes

For i = 1 To Shp.Table.Rows.Count
s = ThisWorkbook.Sheets(1).Range("a65356").End(xlUp).Row + 1

For j = 1 To Shp.Table.Columns.Count
' import data from ppt to excel
Cells(s, j) = Shp.Table.Cell(i, j).Shape.TextFrame.TextRange.Text
Cells(s, j) = Application.WorksheetFunction.Clean(Cells(s, j))
Cells(s, j).Font.Size = 10
Next
Next
Next
Next
PPPres.Close
PPApp.Quit

Set PPSlide = Nothing

'
Set PPPres = Nothing
Set PPApp = Nothing
ThisWorkbook.Activate
ThisWorkbook.Sheets(1).Select

End Sub