title: How can I paste a table and keep formatting from Excel to Powerpoint?
body: <p>I am trying to paste a table from Excel to Powerpoint and keep the source formatting (as a table).</p>
  
  <p>Currently using this to paste:</p>
  
  <pre><code>'Paste to PowerPoint and position
   mySlide.Shapes.PasteSpecial DataType:=ppPasteSourceFormatting,    DisplayAsIcon:=msoFalse
   Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
  </code></pre>
  
  <p>This was working before, but at that time I wasn't selecting a dynamic range and creating a table from it, the table already existed and this code worked fine. </p>
  
  <p>I've tried many different things today, but my knowledge of VB isn't good enough to figure the issue out. Hopefully someone can be my saviour!</p>
  
  <p>The entire code is below:</p>
  
  <pre><code>Sub ExcelRangeToPowerPoint()
  
  'PURPOSE: Copy/Paste An Excel Range Into a New PowerPoint Presentation
  
  Dim rng As Excel.Range
  Dim PowerPointApp As PowerPoint.Application
  Dim myPresentation As PowerPoint.Presentation
  Dim mySlide As PowerPoint.Slide
  Dim myShapeRange As PowerPoint.Shape
  
  'Refresh UsedRange (get rid of "Ghost" cells)
    Worksheets("Task List1").UsedRange
  
  'Select UsedRange
    Worksheets("Task List1").UsedRange.Select
  
  
      ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.UsedRange, , xlYes).Name = "Table1"
      Range("Table1[#All]").Select
  
      ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium9"
      Range("I10").Select
  
  'Copy Range from Excel
    Set rng = ActiveSheet.ListObjects(1).Range
  
  '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
  
  'Make PowerPoint Visible and Active
    PowerPointApp.Visible = True
    PowerPointApp.Activate
  
  'Create a New Presentation
    Set myPresentation = PowerPointApp.Presentations.Open("Y:\Projects\VBa\2932 2 Milestones.pptx")
  
  'Add a slide to the Presentation
    Set mySlide = myPresentation.Slides.Item(1)
  
  'Delete Current table from Powerpoint
    myPresentation.Slides(1).Shapes(2).Delete
  
  'Wait for a few seconds to catch up
    Application.Wait (Now + TimeValue("0:00:3"))
  
  'Copy Excel Range
    rng.Copy
    'ActiveSheet.ListObjects(1).Range.Copy
  
  'Paste to PowerPoint and position
    mySlide.Shapes.PasteSpecial DataType:=ppPasteSourceFormatting, DisplayAsIcon:=msoFalse
    'PowerPointApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
    Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
  
      'Set position:
        myShapeRange.Left = 20
        myShapeRange.Top = 100
        myShapeRange.Height = 400
        myShapeRange.Width = 675
  
  'Clear The Clipboard
    Application.CutCopyMode = False
  
  End Sub
  </code></pre>