Group charts in Excel and then paste them on PowerPoint

If you want to group multiple charts in Excel and paste them on PPT on single slide using VBA. Try this macro -



Sub export_to_ppt()

'In tools Reference add Microsoft PowerPoint

Dim PPApp           As PowerPoint.Application
Dim PPPres          As PowerPoint.Presentation
Dim PPSlide         As PowerPoint.slide
Dim SlideCount      As Integer
Dim shp             As Shape

    Set PPApp = New PowerPoint.Application
    PPApp.Visible = True
    'create new ppt
    Set PPPres = PPApp.Presentations.Add
    

    PPPres.ApplyTemplate Filename:="C:\Program Files\Microsoft Office\Document Themes 12\Median.thmx" ' if you want to apply theme

             SlideCount = PPPres.Slides.Count  'count no of slides
             Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly)     'set layout of slide
             'add header
             PPSlide.Shapes(1).TextFrame.TextRange.Text = "Sales View" ' add chart title as header
             'format header
             With PPSlide.Shapes(1).TextFrame.TextRange.Characters
                 .Font.Size = 30
                 .Font.Name = "Arial"
                 .Font.Color = vbWhite
             End With
             
             With PPSlide.Shapes(1)
                 .Fill.BackColor.RGB = RGB(79, 129, 189)
                 .Height = 50
                 .TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft ' left align the header text
             End With
            
            Set shp = Sheets(1).Shapes.Range(Array("Chart 1", "Chart 2", "Chart 3", "Chart 4")).Group 'GROUP THE CHARTS
            shp.CopyPicture Appearance:=xlScreen, Format:=xlPicture ' COPY THE CHARTS
            shp.Ungroup ' UNGROUP THE CHARTS

             
             PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex ' activate the slide no
             PPSlide.Shapes.Paste.Select ' paste chart
             
             With PPApp.ActiveWindow.Selection.ShapeRange ' ALIGN THE CHART
                .Width = 450
                .Top = 180
                .Align msoAlignCenters, True
            End With
    
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
  
End Sub

Download Working File