Hello Folks

I have got a macro that copies Excel Sheets and pastes onto Powerpoint which works fine, however I have specific sheets which
holds Grouped Shapes (Basically Excel Chart with some Text Boxes) in which case the macro fails.
I have reasonably searched various articles and forums but was not able to resolve.

Appreciate if someone can tweak my code.

 
Sub ExporttoPPT()

'variables
Dim pp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim xlwksht As Worksheet
Dim Xchart As Excel.ChartObject
Dim xlShape As Object
Dim SlideCount As Long
Dim row As Long

'pp variable = Create a new powerpoint presentation
Set pp = CreateObject("PowerPoint.Application")

'Powerpoint presentation = add the object (the finished product) to the poewrpoint presentation
Set PPPres = pp.Presentations.Add

'powerpoint is now visible
pp.Visible = True

'Hide specific Sheets to generate the Pack

For Each wsname In Array(Sheet1.Name, Sheet2.Name, Sheet3.Name, Sheet41.Name)
    Worksheets(wsname).Visible = False
    Next


'range you pick for selection
MyRange = ActiveSheet.PageSetup.PrintArea

'For each worksheet in the active workbook select all the worksheets and wait however many seconds
For Each xlwksht In ActiveWorkbook.Worksheets
  If xlwksht.Visible = True Then
    xlwksht.Select
    Application.Wait (Now + TimeValue("0:00:1"))
    
    'copy the picture from the range you selected
    
    ' Check if there is a shape in the activesheet
    If ActiveSheet.Shapes.Count > 0 Then
      
     ActiveSheet.Shapes("Group1").Select
     
     'Appearance:=xlScreen, Format:=xlPicture

        Else

    
    MyRange = ActiveSheet.PageSetup.PrintArea
        
    xlwksht.Range(MyRange).CopyPicture _
    Appearance:=xlScreen, Format:=xlPicture
    
     End If

    'Slide count
    SlideCount = PPPres.Slides.Count
    Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
    PPSlide.Select

    'paste the shapes
    PPSlide.Shapes.Paste
    pp.ActiveWindow.Selection.ShapeRange.LockAspectRatio = True
    pp.ActiveWindow.Selection.ShapeRange.Top = 20
    pp.ActiveWindow.Selection.ShapeRange.Left = 20
    pp.ActiveWindow.Selection.ShapeRange.Width = 700
    pp.ActiveWindow.Selection.ShapeRange.Height = 350



End If
Next xlwksht

pp.Activate

 
'Cleans it up
Set PPSlide = Nothing
Set PPPres = Nothing
Set pp = Nothing


Sheet1.Visible = True
End Sub