copy selected pages to new document

If you have a long document and want to copy part of it this is a quick way. There is a message box at the start requiring the page range to copy. These pages are then copied to a new document.

Sub SelectPage()

'SelectPage Macro
Dim rCopy As Range
    Dim rCurrent As Range
    Dim sTemp As String
    Dim i As Integer
    Dim iStart As Integer
    Dim iEnd As Integer
    Set rCurrent = Selection.Range

    'Get page numbers to be copied
    sTemp = InputBox("Page range to copy (use format 6-7)", "")
    i = InStr(sTemp, "-")
    If i > 0 Then
        iStart = Val(Left(sTemp, i - 1))
        iEnd = Val(Mid(sTemp, i + 1))
        If iStart < 1 Then iStart = 1
        If iEnd < iStart Then iEnd = iStart
        With ActiveDocument.Range
            If iStart > .Information(wdNumberOfPagesInDocument) Then
                iStart = .Information(wdNumberOfPagesInDocument)
            End If
            If iEnd > .Information(wdNumberOfPagesInDocument) Then
                iEnd = .Information(wdNumberOfPagesInDocument)
            End If
        End With

        'Set the range
        Set rCopy = ActiveDocument.GoTo(What:=wdGoToPage, _
          Which:=wdGoToAbsolute, Count:=iStart)
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, _
        rCopy.End = Selection.Bookmarks("\Page").Range.End
        'Copy range to a new document
        If sTemp > "" Then
            MsgBox "There is no dash character"
        End If
    End If

End Sub

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: