Tengo un inconveniente al pegar la información en word

Esta línea significa que va a pegar en lo que hayas seleccionado en word:

WordApp. Selection. PasteAndFormat 13

Supongo que si tienes seleccionado todo el texto de word, entonces al momento de pegar, sobreescribe lo que traes en memoria sobre word.

Intenta resolverlo moviendo el cursor de word un caracter a la derecha, de esa forma dejará lo que tengas seleccionado.

Entonces antes de la línea de PasteAndFormat pon esta línea:

WordApp. Selection.Move 1, 1

Intenté con esta línea pero sigue ocurriendo lo mismo. Me elimina lo que ya tengo 

Hice una prueba, y noto que eso sucede cuando me crea el archivo de cero en la segunda parte; es decir cuando no existe el archivo y crea uno nuevo. Cuando creo el archivo manualmente no me sucede eso.. 

Cuando crea uno nuevo solamente estás pegando la portada.

Si exacto, pero digamos luego quiero pegar con otra macro información en ese archivo creado y me elimina la portada... o después si ya se creo el archivo con la otra macro y le voy a añadir la portada elimina la información que ya se agregó

Tienes que ejecutar la macro paso a paso y poner puntos de interrupción, como te comenté en alguna otra ocasión.

Entonces cada paso de la macro, revisa cómo está el archivo word, regresas a la macro y ejecutas otra línea, vas a word y revisa qué está haciendo la macro.

De esa manera detecta que tiene seleccionado y por qué te está borrando tu información.

Repite todo nuevamente y antes de pegar, en el documento de word mueve el cursos a alguna parte para evitar que borre la información.

Continúa con la macro para pegar, regresa a word y revisa que no haya borrado.

Ya que sepas como evitar el borrado, me comentas y vemos la manera de ponerlo en el código.

Hice el proceso, y note que al crear un archivo con la marco 1 no lo reconoce en la macro dos y lo sobrescribe como si no existiera. Y así viceversa. Ambas macros crean el archivo si no existe, cuando lo creo con la 2 y luego quiero pegar la información con la 1 esta lo toma como si no existiera y sobrescribe en el mismo tomándolo como nuevo.

Puedes poner aquí la macro2

Sub GUARDAR()
Application.ScreenUpdating = False
'Abre word
  Dim num As Variant
  Dim ruta As String
  Dim TEX2 As String, TEX3 As String
  Dim WordApp As Object
  Dim wdDoc As Object
  'Dim WordApp As Word.Application
  'Dim wdDoc As Word.Document
  '
  'Ambiente
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
    '
  num = Worksheets("Ficha").Range("F2").Value
  ruta = Environ("USERPROFILE") & "\Dropbox\DOCUMENTOS PERSONALES\CONSULTORIO\hISTORIAS CLINICAS\TODAS\"
    '
  'Buscar archivos en la ruta con el número
  archi = Dir(ruta & "*" & num & "*.docx")
 If archi <> "" Then
    'Verifica si el archivo está abierto
    If IsFileOpen(ruta & archi) Then
      Set WordApp = GetObject(, "Word.Application")
      Set wdDoc = WordApp.Documents(ruta & archi)
      wdDoc.Activate
    Else
      Set WordApp = CreateObject("Word.Application")
      Set wdDoc = WordApp.Documents.Open(ruta & archi)
              '
        'Titulo fecha
    Sheets("Ficha").Range("B10").Copy
    'Se pegara en el documento lo copiado en la hoja de calculo
    WordApp.Selection.EndKey Unit:=6
    WordApp.Selection.Move 1, 1
    WordApp.Selection.PasteSpecial xlPasteAllExceptBorders
    'Fecha
    Sheets("Ficha").Range("C10").Copy
    'Se pegara en el documento lo copiado en la hoja de calculo
    WordApp.Selection.EndKey Unit:=6
    WordApp.Selection.Move 1, 1
    WordApp.Selection.PasteSpecial xlPasteValues
     'Titulo Autorización
    Sheets("Ficha").Range("E10").Copy
    'Se pegara en el documento lo copiado en la hoja de calculo
    WordApp.Selection.EndKey Unit:=6
    WordApp.Selection.Move 1, 1
    WordApp.Selection.PasteSpecial xlPasteAllExceptBorders
Else
    'crea nuevo archivo
    Sheets("PORTADA").Range("D3:I34").Copy
    TEX2 = ThisWorkbook.Worksheets("PORTADA").Range("M10").Value
    TEX3 = ThisWorkbook.Worksheets("PORTADA").Range("M11").Value
    Set WordApp = CreateObject("word.Application")
    WordApp.Documents.Add
    WordApp.ActiveDocument.SaveAs ruta & TEX2 & TEX3 & ".doc"
       'Titulo fecha
    Sheets("Ficha").Range("B10").Copy
    'Se pegara en el documento lo copiado en la hoja de calculo
    WordApp.Selection.EndKey Unit:=6
    WordApp.Selection.Move 1, 1
    WordApp.Selection.PasteSpecial xlPasteAllExceptBorders
    'Fecha
    Sheets("Ficha").Range("C10").Copy
    'Se pegara en el documento lo copiado en la hoja de calculo
    WordApp.Selection.EndKey Unit:=6
    WordApp.Selection.Move 1, 1
    WordApp.Selection.PasteSpecial xlPasteValues
 'Titulo Autorización
    Sheets("Ficha").Range("E10").Copy
    'Se pegara en el documento lo copiado en la hoja de calculo
    WordApp.Selection.EndKey Unit:=6
    WordApp.Selection.Move 1, 1
    WordApp.Selection.PasteSpecial xlPasteAllExceptBorders
 WordApp.Documents.Save True
         'Cerrar word
    WordApp.Quit
     Set WordApp = Nothing
    Set wdDoc = Nothing
  End If
  End Sub

Esta es la segunda macro...

Revisa lo siguiente:

En ambas macros estás guardando el archivo con extensión "doc"

WordApp.ActiveDocument.SaveAs ruta & TEX2 & TEX3 & ".doc"

Supongo que debería ser "docx":

WordApp. ActiveDocument.SaveAs ruta & TEX2 & TEX3 & ".docx"

Porque cuando abres los documentos estás abriendo "docx"

archi = Dir(ruta & "*" & num & ".docx")

Cambia todo a docx y prueba.

¡Gracias! Funcionó perfecto