copy paste XL to PPT with 2 ranges - excel

Question

Hello I am using VBA to loop for ranges and copy as picture and paste to PPT slide.
I want to know is there possibility to include 1 more range to code.
So VBA will copy paste 2 ranges as picture.
range is in following code. Works perfectly fine.
range is single cell ( B1 )
Can anyone give me solution how can I add multiple range ( as picture ) to the slide?
Dim PP As PowerPoint.Application
Dim PPpres As PowerPoint.Presentation
Dim PPslide As Object
Dim PpShape As PowerPoint.Shape
Dim SlideTitle As String
Dim SlideNum As Integer
Dim WSrow As Long
Dim Sh As Shape
Dim Rng As Range
Dim myShape As Object
'Open PowerPoint and create new presentation
Set PP = GetObject(class, "PowerPoint.Application")
PP.Visible = True
Set PPpres = PP.Presentations.Open(Filename:="C:\Users\Mac\Desktop\test\PPT.pptx")
'Specify the chart to copy and copy it
For i = 6 To Cells(70, Columns.Count).End(xlToLeft).Column Step 10
With Cells(70, i)
.Resize(1, 10).CopyPicture Appearance:=xlPrinter, Format:=xlPicture
DoEvents
DoEvents
.Offset(15, 0).PasteSpecial
Range("B1").CopyPicture Appearance:=xlPrinter, Format:=xlPicture
DoEvents
DoEvents
.Offset(25, 0).PasteSpecial
End With
'Give the last pasted picture a name.
ActiveSheet.Pictures(ActiveSheet.Pictures.Count).Name = "Chart" & k
'Increase the count for naming pictures by 1
k = k + 1
Set PPslide = PPpres.Slides.Add(1, 10)
PP.ActiveWindow.View.GotoSlide (1)
Set PPslide = PPpres.Slides(1)
'Paste to PowerPoint and position
PPslide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = PPslide.Shapes(PPslide.Shapes.Count)
'Set position:
myShape.Left = 20
myShape.Top = 180
myShape.Height = 250
myShape.Width = 950
'Make PowerPoint Visible and Active
PP.Visible = True
PP.Activate
'Clear The Clipboard
Application.CutCopyMode = False
Next i

Answer 1

The function .CopyPicture does not work on multiple ranges that aren't connected to each other - trying it would return the error message:
Run-time error 1004: this action won't work on multiple selections
So you'll need to execute a separate .CopyPicture for your separate Range (B1), maybe something like (details depending on what exactly you're trying to do):
With Cells(70, i)
.Resize(1, 10).CopyPicture Appearance:=xlPrinter, Format:=xlPicture
.Offset(150, 0).PasteSpecial
Range("B1").CopyPicture Appearance:=xlPrinter, Format:=xlPicture
.Offset(140, 0).PasteSpecial
End With
If you want the multiple ranges to return just one single image, you'll probably have to merge the resulting images in a separate step.