In this post we will explore how VBA paste from Excel to PowerPoint objects such as a Range, Chart or other element. Below you will find working code snippets. We will learn also to modify this routine to address different VBA Copy Paste from Excel to PowerPoint.

VBA Paste Range from Excel to PowerPoint

We will start with an example of VBA Paste Excel Range into PowerPoint as Picture as this is the most typical scenario. For this I created a custom function called CopyFromExcelToPPT:

Function CopyFromExcelToPPT(excelFilePath As String, sheetName As String, rngCopy As String, dstSlide As Long, Optional shapeTop As Long, Optional shapeLeft As Long)
    On Error GoTo ErrorHandl 'Handle Errors
    
    'Set Variables and Open Excel
    Dim eApp As Excel.Application, wb As Excel.Workbook, ppt As PowerPoint.Presentation
    Set eApp = New Excel.Application
    eApp.Visible = False
    Set wb = eApp.Workbooks.Open(excelFilePath)
    Set ppt = ActivePresentation

    'Copy cells in Excel
    wb.Sheets(sheetName).Range(rngCopy).Copy
    
    'Paste into first slide in active PowerPoint presentation
    ppt.Slides(dstSlide).Shapes.PasteSpecial ppPasteBitmap
    
    'Close and clean-up Excel
    wb.Close SaveChanges:=False
    eApp.Quit
    Set wb = Nothing: Set eApp = Nothing
    
    'Move the new shape if left/top provided
    If Not (IsMissing(shapeTop)) Then
        With ppt.Slides(dstSlide).Shapes(ppt.Slides(dstSlide).Shapes.Count)
            .Left = shapeLeft
            .Top = shapeTop
        End With
    End If

    CopyFromExcelToPPT = True
    Exit Function
ErrorHandl:
    'Make sure to close the workbook and Excel and return False
    On Error Resume Next
    If Not (eApp Is Nothing) Then
        wb.Close SaveChanges:=False
        eApp.Quit
    End If
    CopyFromExcelToPPT = False
End Function

What does the VBA Function do? In short you need to provide the following parameters:

• excelFilePath – full file path to the Excel from which you want to copy a VBA Range
• sheetName – the Sheet name from which you want to copy
• rngCopy – the VBA Range you want to copy
• dstSlide – the number of the slide (starting at 1) to which you want to copy the Range
• shapeTop – Optional. The Top position in pixels of the new pasted Shape
• shapeLeft – Optional. The Left position in pixels of the new pasted Shape

Let us use this function in the following scenario. We want to copy range A1:B4.

Let us use our function above for this scenario

Sub Test()
'Copy from Excel worksheet named Sheet1 the A1:B4 range
If CopyFromExcelToPPT("C:\Book.xlsx", "Sheet1", "A1:B4", 1) Then
        Debug.Print "Success"
    Else
        Debug.Print "Failure"
    End If  
End Sub

VBA Paste Chart from Excel to PowerPoint

Now an example of VBA Paste Excel Graph into PowerPoint as Picture as this is also a useful case. For this I created a custom function called CopyChartFromExcelToPPT:

Function CopyChartFromExcelToPPT(excelFilePath As String, sheetName As String, chartName As String, dstSlide As Long, Optional shapeTop As Long, Optional shapeLeft As Long)
    On Error GoTo ErrorHandl 'Handle Errors
    
    'Set Variables and Open Excel
    Dim eApp As Excel.Application, wb As Excel.Workbook, ppt As PowerPoint.Presentation, ws As Excel.Worksheet
    Set eApp = New Excel.Application
    eApp.Visible = False
    Set wb = eApp.Workbooks.Open(excelFilePath)
    Set ppt = ActivePresentation

    'Copy Chart in Excel
    wb.Sheets(sheetName).ChartObjects(chartName).Copy
    
    'Paste into first slide in active PowerPoint presentation
    ppt.Slides(dstSlide).Shapes.PasteSpecial ppPasteBitmap
    
    'Close and clean-up Excel
    wb.Close SaveChanges:=False
    eApp.Quit
    Set wb = Nothing: Set eApp = Nothing
    
    'Move the new shape if left/top provided
    If Not (IsMissing(shapeTop)) Then
        With ppt.Slides(dstSlide).Shapes(ppt.Slides(dstSlide).Shapes.Count)
            .Left = shapeLeft
            .Top = shapeTop
        End With
    End If

    CopyChartFromExcelToPPT = True
    Exit Function
ErrorHandl:
    'Make sure to close the workbook and Excel and return False
    On Error Resume Next
    If Not (eApp Is Nothing) Then
        wb.Close SaveChanges:=False
        eApp.Quit
    End If
    CopyChartFromExcelToPPT = False
End Function

Again let us use it on the example below where we want to copy a Chart from a Excel Workbook to PowerPoint:

Example execution of the VBA Function below:

Sub Test()
    If CopyChartFromExcelToPPT("C:\Book.xlsx", "Sheet1", "Chart 1", 1) Then
        Debug.Print "Success"
    Else
        Debug.Print "Failure"
    End If
End Sub

If you want to place the Chart at a specific place use the shapeTop and shapeLeft arguments. The below will place the chart at 10 pixels from the Top and 100 pixels from the Left.

Sub Test()
    If CopyChartFromExcelToPPT("C:\Book.xlsx", "Sheet1", "Chart 1", 1, 10, 100) Then
        Debug.Print "Success"
    Else
        Debug.Print "Failure"
    End If
End Sub

Changing Height / Width of pasted elements

In the examples above we didn’t change the Width and Height of the pasted Range or Chart. To do this use the adjusted functions below:

Function CopyFromExcelToPPT(excelFilePath As String, sheetName As String, rngCopy As String, dstSlide As Long, Optional shapeTop As Long, Optional shapeLeft As Long, Optional shapeHeight As Long, Optional shapeWidth As Long)
    On Error GoTo ErrorHandl 'Handle Errors
    
    'Set Variables and Open Excel
    Dim eApp As Excel.Application, wb As Excel.Workbook, ppt As PowerPoint.Presentation
    Set eApp = New Excel.Application
    eApp.Visible = False
    Set wb = eApp.Workbooks.Open(excelFilePath)
    Set ppt = ActivePresentation

    'Copy cells in Excel
    wb.Sheets(sheetName).Range(rngCopy).Copy
    
    'Paste into first slide in active PowerPoint presentation
    ppt.Slides(1).Shapes.PasteSpecial ppPasteBitmap
    
    'Close and clean-up Excel
    wb.Close SaveChanges:=False
    eApp.Quit
    Set wb = Nothing: Set eApp = Nothing
    
    'Move the new shape if left/top provided
    If Not (IsMissing(shapeTop)) Then
        With ppt.Slides(1).Shapes(ppt.Slides(1).Shapes.Count)
            .Left = shapeLeft
            .Top = shapeTop
        End With
    End If
    
    'Resize the shape if height/width provided
    If Not (IsMissing(shapeHeight)) Then
        With ppt.Slides(dstSlide).Shapes(ppt.Slides(1).Shapes.Count)
            .Height = shapeHeight
            .Width = shapeWidth
        End With
    End If

    CopyFromExcelToPPT = True
    Exit Function
ErrorHandl:
    'Make sure to close the workbook and Excel and return False
    On Error Resume Next
    If Not (eApp Is Nothing) Then
        wb.Close SaveChanges:=False
        eApp.Quit
    End If
    CopyFromExcelToPPT = False
End Function
Function CopyChartFromExcelToPPT(excelFilePath As String, sheetName As String, chartName As String, dstSlide As Long, Optional shapeTop As Long, Optional shapeLeft As Long, Optional shapeHeight As Long, Optional shapeWidth As Long)
    On Error GoTo ErrorHandl 'Handle Errors
    
    'Set Variables and Open Excel
    Dim eApp As Excel.Application, wb As Excel.Workbook, ppt As PowerPoint.Presentation, ws As Excel.Worksheet
    Set eApp = New Excel.Application
    eApp.Visible = False
    Set wb = eApp.Workbooks.Open(excelFilePath)
    Set ppt = ActivePresentation

    'Copy Chart in Excel
    wb.Sheets(sheetName).ChartObjects(chartName).Copy
    
    'Paste into first slide in active PowerPoint presentation
    ppt.Slides(dstSlide).Shapes.PasteSpecial ppPasteBitmap
    
    'Close and clean-up Excel
    wb.Close SaveChanges:=False
    eApp.Quit
    Set wb = Nothing: Set eApp = Nothing
    
    'Move the new shape if left/top provided
    If Not (IsMissing(shapeTop)) Then
        With ppt.Slides(dstSlide).Shapes(ppt.Slides(1).Shapes.Count)
            .Height = shapeHeight
            .Width = shapeWidth
        End With
    End If
    
    'Resize the shape if height/width provided
    If Not (IsMissing(shapeHeight)) Then
        With ppt.Slides(dstSlide).Shapes(ppt.Slides(1).Shapes.Count)
            .Height = shapeHeight
            .Width = shapeWidth
        End With
    End If
        
    CopyChartFromExcelToPPT = True
    Exit Function
ErrorHandl:
    'Make sure to close the workbook and Excel and return False
    On Error Resume Next
    If Not (eApp Is Nothing) Then
        wb.Close SaveChanges:=False
        eApp.Quit
    End If
    CopyChartFromExcelToPPT = False
End Function