It gives me the following error: "Presentation (unknown member): Object does not exist. I assume it has something to do with defining the variables. Do I have to define another one in order to use: pptPre.ApplyTemplate ("C:\Users\NE70090\AppData\Roaming\Microsoft\Templates\Document Themes\Theme Colors"). It refers to this code of line by the way.

The path is referring to the .potx presentation with the respected office theme.

Option Explicit
 
Sub PPT()
     
    Dim iName As Long
    Dim rName As Range
    Dim nRange As Long
    Dim dSlideCenter As Double
    Dim pptApp As PowerPoint.Application
    Dim pptPre As PowerPoint.Presentation
    Dim pptSld As PowerPoint.Slide
    Dim objSheet As Worksheet
    Dim oshpR As PowerPoint.ShapeRange
     
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPre = pptApp.Presentations.Add
    
     
     ' loop the sheets
    For Each objSheet In ActiveWorkbook.Worksheets
         
         'Create new slide for the data
        Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)
        pptPre.ApplyTemplate ("C:\Users\NE70090\AppData\Roaming\Microsoft\Templates\Document Themes\Theme Colors")
        
        If WorksheetFunction.Count(objSheet.UsedRange) > 0 Then
             ' Data in sheet so copy used range(s)
             
            For iName = 1 To 2
                 ' initialize
                Set rName = Nothing
                nRange = 0
                 
                 ' look for named range
                On Error Resume Next
                Set rName = objSheet.Range("RangeToCopy" & CStr(iName))
                On Error GoTo 0
                 
If Not rName Is Nothing Then ' counter
    nRange = nRange + 1
     ' copy range as picture
    rName.CopyPicture Appearance:=xlScreen, Format:=xlPicture
     ' paste the copied picture
    Set oshpR = pptSld.Shapes.Paste
     
     ' Align pasted shape
    oshpR.Align msoAlignCenters, True
    oshpR.Align msoAlignMiddles, True
End If
Next
 
Else
     ' No data in sheet, so copy chart
    objSheet.ChartObjects(1).Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
     
     ' paste the copied picture
    Set oshpR = pptSld.Shapes.Paste
End If
 
 ' Align pasted shape
oshpR.Align msoAlignCenters, True
oshpR.Align msoAlignMiddles, True
         
        If nRange = 2 Then
            With pptSld.Shapes(pptSld.Shapes.Count - 1) ' first shape of two
                dSlideCenter = .Left + .Width / 2
                .Left = 1.5 * dSlideCenter - .Width / 2 ' center shape in left half of slide
            End With
            With pptSld.Shapes(pptSld.Shapes.Count) ' last shape of two
                .Left = 1.5 * dSlideCenter + .Width / 2 ' center shape in right half of slide
            End With
        End If
    Next
    
End Sub
Many thanks in advance!