Option Explicit

Const sSS As String = "StyleSheet.docx"

Sub Send2StyleSheet()
  Dim sPath As String, docSS As Document, aRng As Range, rngTarget As Range
  Set aRng = Selection.Range
  If Len(aRng.Text) > 0 Then
    sPath = ActiveDocument.Path & Application.PathSeparator
    Set docSS = GetSS(sPath)
    Set rngTarget = docSS.Range
    rngTarget.Collapse Direction:=wdCollapseEnd
    rngTarget.Text = vbCr & aRng.Text
  End If
End Sub

Function GetSS(sPath As String) As Document
  Dim aDoc As Document
  For Each aDoc In Documents
    If aDoc.FullName = sPath & sSS Then
      Set GetSS = aDoc
      Exit For
    End If
  Next aDoc
  If GetSS Is Nothing Then
    Set GetSS = Documents.Add()
    GetSS.SaveAs FileName:=sPath & sSS
  End If
End Function