Okkkks, вот так заработало:
Sub Perenos()
Selection.WholeStory
Selection.Range.Copy
Dim MyData As DataObject
Set MyData = New DataObject
NameD = ThisDocument.Name
Set WordApp = New Word.Application
WordApp.Visible = True
Set DocWord = WordApp.Documents.Add
DocWord.Activate
DocWord.Application.Selection.Range.Paste
DocWord.SaveAs NameD
ThisDocument.Close True
End Sub
Добавил 'DocWord.Application.Selection.Range.Paste'
У тебя, видимо, Selection использовался в контексте первого документа и в него же вставлял, заменяя старое значение.