Sub CreatePowerPointSlides() Dim PowerPointApp As Object Dim PowerPointPres As Object Dim PowerPointSlide As Object Dim SlideNum As Integer ' Create a new instance of PowerPoint Set PowerPointApp = CreateObject("PowerPoint.Application") PowerPointApp.Visible = True ' Create a new presentation Set PowerPointPres = PowerPointApp.Presentations.Add ' Loop through the worksheets in Excel and create a slide for each worksheet For Each ws In ThisWorkbook.Worksheets ' Add a new slide to the presentation Set PowerPointSlide = PowerPointPres.Slides.Add(SlideNum + 1, 12) ' 12 represents the slide layout (e.g., Title and Content) ' Set the title of the slide to the worksheet name PowerPointSlide.Shapes(1).TextFrame.TextRange.Text = ws.Name ' Copy the contents of the worksheet to the slide ws.UsedRange.Copy PowerPointSlide.Shapes(2).TextFrame.TextRange.Paste ' Increment the slide number SlideNum = SlideNum + 1 Next ws ' Clean up objects Set PowerPointSlide = Nothing Set PowerPointPres = Nothing Set PowerPointApp = Nothing End Sub