View Single Post
 
Old 05-02-2021, 02:44 AM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,105
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

You could use a macro in your normal template to copy the selection to another document with a single click e.g.
Code:
Sub SaveExtractToDocument()
'Graham Mayor - https://www.gmayor.com - Last updated - 02 May 2021
Dim oDoc As Document, oNewDoc As Document
Dim oRng As Range, oNewRng As Range
Dim strPath As String
Dim FSO As Object

    If Documents.Count = 0 Then
        MsgBox "No document open", vbCritical
        GoTo lbl_Exit
    End If

    If Len(Selection) = 1 Then
        MsgBox "Nothing selected", vbCritical
        GoTo lbl_Exit
    End If

    Set oDoc = ActiveDocument
    strPath = Environ("USERPROFILE") & "\Desktop\Extract.docx"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(strPath) Then
        Set oNewDoc = Documents.Open(strPath)
    Else
        Set oNewDoc = Documents.Add
        oNewDoc.SaveAs2 strPath
    End If
    oDoc.Activate
    Set oRng = Selection.Range
    oRng.Copy
    Set oNewRng = oNewDoc.Range
    oNewRng.Collapse 0
    oNewRng.Paste
    oNewRng.InsertParagraphAfter
    'oNewDoc.Save 'Optional
lbl_Exit:
    Set oDoc = Nothing
    Set oNewDoc = Nothing
    Set oRng = Nothing
    Set oNewRng = Nothing
    Set FSO = Nothing
    Exit Sub
End Sub
Installing Macros
In this case the macro will add the selection to the end of a document 'Extract.docx' which it will create and save on your desktop if not already present.
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote