Sub SaveSelectedTextToNewDocument()
    If Selection.Words.Count > 0 Then
    'Copy the selected text

    'Open a new document and paste the copied text into it
    Dim objNewDoc As Document
    Set objNewDoc = Documents.Add

    'Get the first 10 characters as the filename of the new document and save them
    Dim objFileName As Range
    Set objFileName = objNewDoc.Range(Start:=0, End:=10)
    objNewDoc.SaveAs FileName:="C:\Users\Test\Desktop\" & objFileName & ".docx"

    End If
End Sub
downloadDownload PNG downloadDownload JPEG downloadDownload SVG

Tip: You can change the style, width & colours of the snippet with the inspect tool before clicking Download!

Click to optimize width for Twitter