Issue Copying and Pasting into PowerPoint

[TyThompson]

Hi,

Thank you for taking the time to look at this. I really appreciate it.

I've inserted the code I used from TheSpreadsheetGuru below (I only changed the worksheet and the ranges). It all worked perfectly, initially. But then I changed the range to include columns E through X (not just through V that I had at first), and all of a sudden the code still copy and pastes but doesn't take the whole selection. It gets cut off from the right and from the bottom. I autofit the height for column X before running the macro so it would include the sentences in column X--and I am wondering if that could be a potential issue? Some of the values in X make the selection really tall.

I've included a screenshot of my first copy and paste selection--I am filtering rows, but that did not seem to be an issue initially. It was only after I extended the range to include the commentary column X.

[FONT=&quot]Sub[/FONT][FONT=&quot] PasteMultipleSlides()[/FONT]

[FONT=&quot]'PURPOSE: Copy Excel Ranges and Paste them into the Active PowerPoint presentation slides[/FONT]
[FONT=&quot]'SOURCE: www.TheSpreadsheetGuru.com[/FONT]

[FONT=&quot]Dim[/FONT][FONT=&quot] myPresentation [/FONT][FONT=&quot]As[/FONT][FONT=&quot] [/FONT][FONT=&quot]Object[/FONT]
[FONT=&quot]Dim[/FONT][FONT=&quot] mySlide [/FONT][FONT=&quot]As[/FONT][FONT=&quot] [/FONT][FONT=&quot]Object[/FONT]
[FONT=&quot]Dim[/FONT][FONT=&quot] PowerPointApp [/FONT][FONT=&quot]As[/FONT][FONT=&quot] [/FONT][FONT=&quot]Object[/FONT]
[FONT=&quot]Dim[/FONT][FONT=&quot] shp [/FONT][FONT=&quot]As[/FONT][FONT=&quot] [/FONT][FONT=&quot]Object[/FONT]
[FONT=&quot]Dim[/FONT][FONT=&quot] MySlideArray [/FONT][FONT=&quot]As[/FONT][FONT=&quot] [/FONT][FONT=&quot]Variant[/FONT]
[FONT=&quot]Dim[/FONT][FONT=&quot] MyRangeArray [/FONT][FONT=&quot]As[/FONT][FONT=&quot] [/FONT][FONT=&quot]Variant[/FONT]
[FONT=&quot]Dim[/FONT][FONT=&quot] x [/FONT][FONT=&quot]As[/FONT][FONT=&quot] [/FONT][FONT=&quot]Long[/FONT]

[FONT=&quot]'Create an Instance of PowerPoint[/FONT]
[FONT=&quot]  [/FONT][FONT=&quot]On[/FONT][FONT=&quot] [/FONT][FONT=&quot]Error[/FONT][FONT=&quot] [/FONT][FONT=&quot]Resume[/FONT][FONT=&quot] [/FONT][FONT=&quot]Next[/FONT]
[FONT=&quot]    [/FONT]
[FONT=&quot]    [/FONT][FONT=&quot]'Is PowerPoint already opened?[/FONT]
[FONT=&quot]      [/FONT][FONT=&quot]Set[/FONT][FONT=&quot] PowerPointApp = GetObject(class:="PowerPoint.Application")[/FONT]
[FONT=&quot]    [/FONT]
[FONT=&quot]    [/FONT][FONT=&quot]'Clear the error between errors[/FONT]
[FONT=&quot]      Err.Clear[/FONT]

[FONT=&quot]    [/FONT][FONT=&quot]'If PowerPoint is not already open then Exit[/FONT]
[FONT=&quot]      [/FONT][FONT=&quot]If[/FONT][FONT=&quot] PowerPointApp [/FONT][FONT=&quot]Is[/FONT][FONT=&quot] [/FONT][FONT=&quot]Nothing[/FONT][FONT=&quot] [/FONT][FONT=&quot]Then[/FONT]
[FONT=&quot]        MsgBox "PowerPoint Presentation is not open, aborting."[/FONT]
[FONT=&quot]        [/FONT][FONT=&quot]Exit[/FONT][FONT=&quot] [/FONT][FONT=&quot]Sub[/FONT]
[FONT=&quot]      [/FONT][FONT=&quot]End[/FONT][FONT=&quot] [/FONT][FONT=&quot]If[/FONT]
[FONT=&quot]    [/FONT]
[FONT=&quot]    [/FONT][FONT=&quot]'Handle if the PowerPoint Application is not found[/FONT]
[FONT=&quot]      [/FONT][FONT=&quot]If[/FONT][FONT=&quot] Err.Number = 429 [/FONT][FONT=&quot]Then[/FONT]
[FONT=&quot]        MsgBox "PowerPoint could not be found, aborting."[/FONT]
[FONT=&quot]        [/FONT][FONT=&quot]Exit[/FONT][FONT=&quot] [/FONT][FONT=&quot]Sub[/FONT]
[FONT=&quot]      [/FONT][FONT=&quot]End[/FONT][FONT=&quot] [/FONT][FONT=&quot]If[/FONT]

[FONT=&quot]  [/FONT][FONT=&quot]On[/FONT][FONT=&quot] [/FONT][FONT=&quot]Error[/FONT][FONT=&quot] [/FONT][FONT=&quot]GoTo[/FONT][FONT=&quot] 0[/FONT]
[FONT=&quot]  [/FONT]
[FONT=&quot]'Make PowerPoint Visible and Active[/FONT]
[FONT=&quot]  PowerPointApp.ActiveWindow.Panes(2).Activate[/FONT]
[FONT=&quot]    [/FONT]
[FONT=&quot]'Create a New Presentation[/FONT]
[FONT=&quot]  [/FONT][FONT=&quot]Set[/FONT][FONT=&quot] myPresentation = PowerPointApp.ActivePresentation[/FONT]

[FONT=&quot]'List of PPT Slides to Paste to[/FONT]
[FONT=&quot]  MySlideArray = Array(2, 3, 4)[/FONT]

[FONT=&quot]'List of Excel Ranges to Copy from[/FONT]
[FONT=&quot]    [/FONT]MyRangeArray = Array(Sheet25.Range("E5:X33"), Sheet25.Range("E38:X66"), _      Sheet25.Range("E71:X99"))

[FONT=&quot]'Loop through Array data[/FONT]
[FONT=&quot]  [/FONT][FONT=&quot]For[/FONT][FONT=&quot] x = [/FONT][FONT=&quot]LBound[/FONT][FONT=&quot](MySlideArray) [/FONT][FONT=&quot]To[/FONT][FONT=&quot] [/FONT][FONT=&quot]UBound[/FONT][FONT=&quot](MySlideArray)[/FONT]
[FONT=&quot]    [/FONT][FONT=&quot]'Copy Excel Range[/FONT]
[FONT=&quot]        MyRangeArray(x).Copy[/FONT]
[FONT=&quot]    [/FONT]
[FONT=&quot]    [/FONT][FONT=&quot]'Paste to PowerPoint and position[/FONT]
[FONT=&quot]      [/FONT][FONT=&quot]On[/FONT][FONT=&quot] [/FONT][FONT=&quot]Error[/FONT][FONT=&quot] [/FONT][FONT=&quot]Resume[/FONT][FONT=&quot] [/FONT][FONT=&quot]Next[/FONT]
[FONT=&quot]        [/FONT][FONT=&quot]Set[/FONT][FONT=&quot] shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2) [/FONT][FONT=&quot]'Excel 2007-2010[/FONT]
[FONT=&quot]        [/FONT][FONT=&quot]Set[/FONT][FONT=&quot] shp = PowerPointApp.ActiveWindow.Selection.ShapeRange [/FONT][FONT=&quot]'Excel 2013[/FONT]
[FONT=&quot]      [/FONT][FONT=&quot]On[/FONT][FONT=&quot] [/FONT][FONT=&quot]Error[/FONT][FONT=&quot] [/FONT][FONT=&quot]GoTo[/FONT][FONT=&quot] 0[/FONT]
[FONT=&quot]    [/FONT]
[FONT=&quot]    [/FONT][FONT=&quot]'Center Object[/FONT]
[FONT=&quot]      [/FONT][FONT=&quot]With[/FONT][FONT=&quot] myPresentation.PageSetup[/FONT]
[FONT=&quot]        shp.Left = (.SlideWidth \ 2) - (shp.Width \ 2)[/FONT]
[FONT=&quot]        shp.Top = (.SlideHeight \ 2) - (shp.Height \ 2)[/FONT]
[FONT=&quot]      [/FONT][FONT=&quot]End[/FONT][FONT=&quot] [/FONT][FONT=&quot]With[/FONT]
[FONT=&quot]      [/FONT]
[FONT=&quot]  [/FONT][FONT=&quot]Next[/FONT][FONT=&quot] x[/FONT]

[FONT=&quot]'Transfer Complete[/FONT]
[FONT=&quot]  Application.CutCopyMode = [/FONT][FONT=&quot]False[/FONT]
[FONT=&quot]  ThisWorkbook.Activate[/FONT]
[FONT=&quot]  MsgBox "Complete!"[/FONT]

[FONT=&quot]End[/FONT][FONT=&quot] [/FONT][FONT=&quot]Sub

[/FONT]



https://postimg.org/image/hi02ai0zb/

 

[Worf]

Welcome to the Board

o Rows that were filtered out will not appear on the slide, but the filter itself should not interfere with the data transfer.
o The code below worked for me, but the cells can become tiny and difficult to read at PowerPoint.
o I tested with Office 2013.

Sub PasteMultipleSlides()
'SOURCE: www.TheSpreadsheetGuru.com
Dim pres As Object, mySlide As Object, PowerPointApp As Object, _
shp As Object, MySlideArray, Arr, x&
On Error Resume Next
Set PowerPointApp = GetObject(Class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
If PowerPointApp Is Nothing Then
    MsgBox "PowerPoint Presentation is not open, aborting."
    Exit Sub
End If
'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
PowerPointApp.ActiveWindow.Panes(2).Activate
Set pres = PowerPointApp.ActivePresentation
MySlideArray = Array(2, 3, 4) 'List of PPT Slides to Paste to
Arr = Array(Plan1.Range("E5:X33"), Plan1.Range("E38:X66"), Plan1.[E71:X99])
For x = LBound(MySlideArray) To UBound(MySlideArray)
    Arr(x).Copy
    Set shp = pres.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2)
    With pres.PageSetup
        shp.Left = (.SlideWidth \ 2) - (shp.Width \ 2)  'Center Object
        shp.Top = (.SlideHeight \ 2) - (shp.Height \ 2)
    End With
Next
Application.CutCopyMode = False
ThisWorkbook.Activate
MsgBox "Complete!"
End Sub