Copy Text and Retain Numbers When Pasting

You may often be in a situation where you need to copy part of a document to another place, e.g. an e-mail. However, if your document includes automatic numbered text such as numbered headings, this may cause problems if the part you want to copy does not include the first numbered item(s) in the document. In that case, the numbers in the original document and the text you paste will not match.

This article provides a macro solution that will create a copy of the text in which the automatic numbers have been converted to normal text so that the numbers are retained when pasted.

Macro solution

What to do - how to use the macro

You can copy the macro via the link below. Once you have installed the macro, all you have to do when you need to copy text with automatic numbers and retain the numbers is:

Select the content to be copied.
Run the macro.
Go to the destination and paste.

Note that the original document will remain unchanged.

The macro

Below, you will find the macro code. If you need help on installing macros, see How to install a macro.

Sub CreateCopyOfSelection_ChangeAutomaticNumbersToNormalText()
    
    '=========================
    'Macro created 2009 by Lene Fredborg, DocTools - www.thedoctools.com
    'THIS MACRO IS COPYRIGHT. YOU ARE WELCOME TO USE THE MACRO BUT YOU MUST KEEP THE LINE ABOVE.
    'YOU ARE NOT ALLOWED TO PUBLISH THE MACRO AS YOUR OWN, IN WHOLE OR IN PART.    
    '=========================
    'For information about the macro, see the Msg text below
    '=========================
    
    Dim oDoc As Document
    Dim oRange As Range
    Dim Msg As String
    Dim Title As String
    Dim Response As VbMsgBoxResult
    
    Title = "Create Copy of Selection - Change Automatic Numbers to Normal Text"
    Set oDoc = ActiveDocument
    
    'Stop if no text selected
    If oDoc.Bookmarks("\Sel").Range.Text = "" Then
        Msg = "Before running the command, you must select the text you want to " & _
            "copy for insertion elsewhere."
        MsgBox Msg, vbOKOnly, Title
        GoTo ExitHere
    End If
        
    Msg = "Use this command if you need to copy part of a document with automatic numbering " & _
        "to somewhere else, e.g. an e-mail." & vbCr & _
        "The command changes the automatic numbers in the copy to normal text " & _
        "so that the correct numbers are retained when you paste the text elsewhere." & vbCr & vbCr & _
        "Before running the command, you must select the text you want to insert elsewhere. " & vbCr & vbCr & _
        "When the command is finished, go to the destination and paste the text." & vbCr & vbCr & _
        "NOTE: the active document will remain unchanged."
    
    Response = MsgBox(Msg, vbOKCancel, Title)
    
    'Stop if the user does not click OK
    If Response <> vbOK Then GoTo ExitHere
        
    Set oRange = _
        oDoc.Range(Start:=Selection.Range.Start, _
        End:=Selection.Range.End)
    oRange.ListFormat.ConvertNumbersToText wdNumberParagraph
    
    'Copy the selection while numbers are converted
    Selection.Copy
    
    'Then undo so that numbers revert to the original in oDoc
    oDoc.Undo
    
    Msg = "Finished. You may now go to the destination and paste the text."
    MsgBox Msg, vbOKOnly, Title
    
ExitHere:
    'Clean up
    Set oDoc = Nothing
    Set oRange = Nothing

End Sub

Related information

See About VBA Macros and Code Snippets and How to Install a Macro for misc. information that may help you in your work with macros and for information about how to install macros.