VBA - How to store excel range variables into an array and paste into PowerPoint

Option Explicit
Option Compare Text 'Case Insensitive
 
Dim objPPTApp As Object, _
    objPPT As Object, _
    objPPTSlides As Object, _
    objPPTPres As Object, _
    objPPTSlide As Object
Dim strTargetFile As String, _
    strDirectory As String
Dim rngPage1 As Range, _
    rngPage2 As Range, _
    rngPage3 As Range, _
    rngPage4 As Range, _
    rngPage5 As Range
    
    
Sub OpenPowerPoint() 'Open PowerPoint Application
 
'The following code will _
1) Open PowerPoint (if it is not already opened), _
2) If PowerPoint application already running, reference an variable to the application _
3) Make PowerPoint visible to ensure proper manipulation
 
'If error, resume the code
On Error Resume Next
 
'Grab PowerPoint (assuming PowerPt is open)
Set objPPTApp = GetObject(, "PowerPoint.application")
 
'If error # is 429, PowerPoint Application is not open at all
If Err.Number = 429 Then
    'Create a new instance of PowerPoint since none are open
    Set objPPTApp = CreateObject("PowerPoint.application")
End If
 
'Make PowerPoint Visible or further manipulation is not possible
objPPTApp.Visible = True
 
End Sub
Sub OpenPPTFile() 'Open Specific PowerPoint Presentation
 
'The following code will _
1) Set up path to target folder _
2) Set up path to PowerPoint file name _
3) If PowerPoint file is not already open _
        a) Open the target Powerpoint File and reference it _
        b) Reference the PowerPoint file if already open
 
'Setting location of Excel Workbook
strDirectory = "H:\apps\xp\Desktop\ScoreCards\" 'Root Directory
strTargetFile = "Test.ppt" 'File Name
 
'If Excel spreadsheet "Test.PPT" is NOT open
If Not IsPPTOpen(strTargetFile) Then
    'set objPPT = Test.PPT
    Set objPPT = objPPTApp.Presentations.Open(strDirectory & strTargetFile)
Else
 
'If Excel spreadsheet "Test.PPT" is already open, set objPPT to point as "Test.PPT"
Set objPPT = objPPTApp.Presentations.Item(strDirectory & strTargetFile)
End If
 
End Sub
'This Function checks if the specific PowerPoint file is open
Function IsPPTOpen(strTargetFile As String) As Boolean 'The Default Value of Boolean is "FALSE"
    Dim i As Long
    'Count all the existing PowerPoint files open backwards, and
    For i = objPPTApp.Presentations.Count To 1 Step -1
        'If file name = the file of interest
        If objPPTApp.Presentations(i).Name = strTargetFile Then
            'Set function boolean to "TRUE"
            IsPPTOpen = True
        End If
    Next i
End Function
Sub DeletePowerPTPictures()
 
Set objPPTPres = objPPT
Set objPPTSlides = objPPTPres.Slides
 
Dim lngShapesCount As Long
Dim lngSlidesCount As Long
    
'For Each slides use this link http://www.ozgrid.com/forum/showthread.php?t=52682
 
'Counting how many slides in PowerPoint backwards to the 2nd slide
For lngSlidesCount = objPPTSlides.Count To 2 Step -1
    'Counting how many shapes are on each PowerPoint slide (one at a time)
    For lngShapesCount = objPPTSlides(lngSlidesCount).Shapes.Count To 1 Step -1
        'For each slides's shapes
        With objPPTSlides(lngSlidesCount).Shapes(lngShapesCount)
            'If any shape matches type "13" or "msoPicture",
            If .Type = msoPicture Then
                'delete and go to next shape then slide
                .Delete
            End If
        End With
    Next lngShapesCount
Next lngSlidesCount
 
     
End Sub
Sub SelectExcelRange()
 
Call OpenPowerPoint
Call OpenPPTFile
Call DeletePowerPTPictures
 
Set rngPage1 = sht1.Cells(3, 3).Resize(24, 17)
Set rngPage2 = sht2.Cells(3, 3).Resize(31, 17)
Set rngPage3 = sht3.Cells(3, 3).Resize(31, 9)
Set rngPage4 = sht4.Cells(3, 3).Resize(25, 9)
Set rngPage5 = sht5.Cells(3, 3).Resize(26, 8)
 
Dim arrPages()
ReDim arrPages(1 To 5)
 
arrPages(1) = rngPage1
arrPages(2) = rngPage2
arrPages(3) = rngPage3
arrPages(4) = rngPage4
arrPages(5) = rngPage5
 
'This method works
'rngPage1.CopyPicture xlScreen, xlPicture
'Set objPPTSlide = objPPTPres.Slides(2)
'objPPTSlide.Shapes.Paste
 
'This method doesn't work, I'm trying to loop it
Dim i As Long
For i = 1 To 5
   With arrPages(i)
      Cells.CopyPicture xlScreen, xlPicture 'Not the right way since it takes all the cells.
    End With
Set objPPTSlide = objPPTPres.Slides.Range(i + 1)
objPPTSlide.Shapes.Paste
Set objPPTSlide = Nothing
Next i
 
End Sub

                                  

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141: