Macro Code to Copy Content from Excel File to PowerPoint, Each Row to Each Slide

Requirement
1. Need to Copy data from Excel Column A, to Power Point
2. Row 1 data Go to Slide 1
3. Row 2 data will go to Slide 2
4. Row 3 data will go to slide 3

PreRequisite

• I have some content in Excel in Column "A"
• Column "A", have at least 1 record in cell A1 and can have any number of records in row
• Must have PowerPoint file with you 
• Decide your template before hand
• You must have slides ready in PowerPoint
• Number of Slides must be Equal to the number of Row in Excel , which need to Copy over
• Below Macro Code need to be execute in Excel

1. Click on Macro
2. Type any Name and Click on "Create" button
3. New Popup will be there and Copy Paste Below Macro Code (Replace existing Sub/End Sub) and Save 

• Run Code
• On Successful execution of code, PowerPoint file will Open and Close
• Only PowerPoint without any file stay Open, If yes Close it manually
• On VB window, you can see the dialog box "Done"
• If yes your code executed without any error

Sub ExcelRowtoPPT()
    Dim sht As Worksheet
    Dim PPApp As PowerPoint.Application
    Dim PPShape As PowerPoint.Shape
    Dim PPPresentation As PowerPoint.Presentation
    Dim PPTSlide As Slide
    Dim V_PPTPath As String
Dim V_PPTPath_New As String
    V_PPTPath = "C:\Users\UserName\Desktop\macro\Presentation1.pptx"
    V_PPTPath_New = "C:\Users\UserName\Desktop\macro\Presentation1.pptx"
    Set PPApp = CreateObject("PowerPoint.Application")
    PPApp.Visible = msoTrue
    Set PPPresentation = PPApp.Presentations.Open(V_PPTPath)
    For Each PPTSlide In PPPresentation.Slides
        i = PPTSlide.SlideNumber
Set sht = Worksheets("Sheet1")
        sht.Activate
        Dim S2 As String
        Dim Cellname As String
        Cellname = "A" & i
            sht.Range(Cellname).Copy
            PPTSlide.Shapes.Paste
             With PPApp
                .ActiveWindow.Selection.ShapeRange.Align msoAlignTops, True
                .ActiveWindow.Selection.ShapeRange.Top = 350
                .ActiveWindow.Selection.ShapeRange.Left = 650
                .ActiveWindow.Selection.ShapeRange.Width = 400
             End With
        Application.ScreenUpdating = True
    Next
    PPApp.Activate
    PPPresentation.SaveAs V_PPTPath_New
    PPPresentation.Close
    PPApp.Quit
    Set PPShape = Nothing
    Set PPPresentation = Nothing
    Set PPApp = Nothing
    MsgBox "Done", vbOKOnly + vbInformation
End Sub

You might face clipboard Error while executing the above code, if you are still facing the error then try to re-execute the code by 2 or 3 times.