Sub SplitFile()
    Dim lSlidesPerFile&, lTotalSlides&, oSourcePres As Presentation, otargetPres As Presentation
    Dim sFolder$, sExt$, sBaseName$, lCounter&, lPresentationsCount&, x&, lWindowStart&
    Dim lWindowEnd&, sSplitPresName$

    On Error GoTo ErrorHandler

    Set oSourcePres = ActivePresentation
    If Not oSourcePres.Saved Then
        MsgBox "Please save your presentation then try again"
        Exit Sub
    End If

    lSlidesPerFile = CLng(InputBox("How many slides per file?", "Split Presentation"))
    lTotalSlides = oSourcePres.Slides.Count
    sFolder = ActivePresentation.Path & "\"
    sExt = Mid$(ActivePresentation.Name, InStr(ActivePresentation.Name, ".") + 1)
    sBaseName = Mid$(ActivePresentation.Name, 1, InStr(ActivePresentation.Name, ".") - 1)

    If (lTotalSlides / lSlidesPerFile) - (lTotalSlides \ lSlidesPerFile) > 0 Then
        lPresentationsCount = lTotalSlides \ lSlidesPerFile + 1
    Else
        lPresentationsCount = lTotalSlides \ lSlidesPerFile
    End If

    If Not lTotalSlides > lSlidesPerFile Then
        MsgBox "There are fewer than " & CStr(lSlidesPerFile) & " slides in this presentation."
        Exit Sub
    End If

    For lCounter = 1 To lPresentationsCount

        ' which slides will we leave in the presentation?
        lWindowEnd = lSlidesPerFile * lCounter
        If lWindowEnd > oSourcePres.Slides.Count Then
            ' odd number of leftover slides in last presentation
            lWindowEnd = oSourcePres.Slides.Count
            lWindowStart = ((oSourcePres.Slides.Count \ lSlidesPerFile) * lSlidesPerFile) + 1
        Else
            lWindowStart = lWindowEnd - lSlidesPerFile + 1
        End If

        ' Make a copy of the presentation and open it
        sSplitPresName = sFolder & sBaseName & _
               "_" & CStr(lWindowStart) & "-" & CStr(lWindowEnd) & "." & sExt
        oSourcePres.SaveCopyAs sSplitPresName, ppSaveAsDefault
        Set otargetPres = Presentations.Open(sSplitPresName, , , True)

        With otargetPres
            For x = .Slides.Count To lWindowEnd + 1 Step -1
                .Slides(x).Delete
            Next
            For x = lWindowStart - 1 To 1 Step -1
                .Slides(x).Delete
            Next
            .Save
            .Close
        End With

    Next    ' lpresentationscount

NormalExit:
    Exit Sub
ErrorHandler:
    MsgBox "Error encountered"
    Resume NormalExit
End Sub