Copy and Paste from Excel to PowerPoint using VBA - excel

Question

I have specific columns' names in Excel that I want to copy and paste into PowerPoint but I can't run the code because I get "Run Error 424." I have tried using ("B3:Q3") for the columns and that works. However, I don't want all those columns, I only want the columns that are listed below ("b3,f3,l3,n3,p3,q3").
Can anyone assist? Thank you so much!
Sub ExcelRangeToPowerPoint()
Dim rng As Range
Dim rng1 As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
'Copy Range from Excel
Set rng = ThisWorkbook.ActiveSheet.Range("b3,f3,l3,n3,p3,q3").Select 'THIS IS THE ERROR
Set rng1 = ThisWorkbook.ActiveSheet.Range("G4:I4")
'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
'Optimize Code
Application.ScreenUpdating = False
'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Add
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
'Copy Excel Range
rng.Copy
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=7 '7 = ppPasteText
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:rng
myShape.Left = 70
myShape.Top = 150
myShape.Width = 800
myShape.Height = 100
'Copy Excel Range
rng1.Copy
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=7 '7 = ppPasteText
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:rng
myShape.Left = 70
myShape.Top = 200
myShape.Width = 800
myShape.Height = 300
'Insert the tile on the ppt
mySlide.Shapes.Title.TextFrame.TextRange.Text = "Insert Title Here"
'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate
'Clear The Clipboard
Application.CutCopyMode = False
End Sub

Answer 1

Take off the .Select.
1) You can't Set Rng = [whatever].Select. You want to do Set Rng = [whatever] then Rng.Select on a new line, but more importantly,
2) It's best to Avoid using .Select/.Activate. Although you don't seem to use it elsewhere (good!), so I bet this is just a "typo".
Also, if you want the Columns then you would do:
Set rng = ThisWorkbook.ActiveSheet.Range("b3,f3,l3,n3,p3,q3").EntireColumn
Edit: This won't solve the issue of it pasting the in-between columns, but this (admittedly a little klunky) code will select just the data used (including headers), instead of the entire columns:
'Copy Range from Excel
Dim lastRow As Long
With ThisWorkbook.ActiveSheet
lastRow = .Cells(Rows.Count, 2).End(xlUp).Row
' I assume your headers actually are in row 3, and the data is in row 4 on ward:
Set rng = ThisWorkbook.ActiveSheet.Range("b3:B" & lastRow & ",f3:F" & lastRow & ",l3:l" & lastRow & ",n3:N" & lastRow & ",p3:P" & lastRow & ",q3:Q" & lastRow)
Set rng1 = ThisWorkbook.ActiveSheet.Range("G4:I4")
End With
'Create an Instance of PowerPoint
On Error Resume Next
' Etc. etc.