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