Abrir un doc de word especifico o si esta abierto continuar

Prueba lo siguiente:

Sub PORTADA()
  'Declaración de variables
  Dim num As Variant
  Dim ruta As String, archi 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
  '
  'Buscar archivos en la ruta con el número
  num = Worksheets("Ficha").Range("F2").Value
  ruta = "C:\Users\Laura\Dropbox\TODAS\"
  archi = Dir(ruta & "*" & num & "*.docx")
  '
  If archi <> "" Then
    '
    'Verifica si el archivo está abierto
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    On Error GoTo 0
    If WordApp Is Nothing Then
      Set WordApp = CreateObject("Word.Application")
    End If
    WordApp.Visible = True
    On Error Resume Next
    Set wdDoc = WordApp.Documents(ruta & archi)
    On Error GoTo 0
    If wdDoc Is Nothing Then
      'Abre el archivo
      Set wdDoc = WordApp.Documents.Open(ruta & archi)
    Else
      'activa el archivo
      WdDoc. Activate
    End If
    Sheets("PORTADA"). Range("D3:I34"). Copy
    'Se pegara en el documento lo copiado en la hoja de calculo
    WordApp. Selection. PasteAndFormat 13
    WordApp. Selection. InsertBreak
    WordApp. Selection.Move 6, -1
    WordApp.ActiveDocument.PrintOut Range:=2
    WordApp.Documents.Save True
  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.Selection.PasteAndFormat 13
    WordApp.Selection.InsertBreak
    WordApp.Selection.Move 6, -1
    WordApp.ActiveDocument.PrintOut Range:=2 ' wdPrintCurrentPage
    WordApp.ActiveDocument.SaveAs ruta & TEX2 & TEX3 & ".doc"
  End If
  'Cerrar word
  'WordApp.Quit
  Set WordApp = Nothing
  Set wdDoc = Nothing
  '
  Application.ScreenUpdating = True
  Application.CutCopyMode = False
End Sub

Hola, te agradezco. Sin embargo, aunque me funciona me abre un documento nuevo de word y me aparece que el archivo esta bloqueado para edición de invitado. No sé como quitar eso... ya revisé de evarias maneras

Mira 

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 = "C:\Users\Laura\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
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    On Error GoTo 0
    If WordApp Is Nothing Then
      Set WordApp = CreateObject("Word.Application")
    End If
    WordApp.Visible = True
    On Error Resume Next
    Set wdDoc = WordApp.Documents(ruta & archi)
    On Error GoTo 0
    If wdDoc Is Nothing Then
      'Abre el archivo
      Set wdDoc = WordApp.Documents.Open(ruta & archi)
    Else
      'activa el archivo
      wdDoc.Activate
    End If
     '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.PasteSpecial xlPasteAllExceptBorders
WordApp.Documents.Save
         'Cerrar word
    WordApp.Quit
    Set WordApp = Nothing
    Set wdDoc = Nothing
  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.PasteSpecial xlPasteAllExceptBorders
WordApp.Documents.Save
         'Cerrar word
    WordApp.Quit
    Set WordApp = Nothing
    Set wdDoc = Nothing
  End If
  Application.ScreenUpdating = True
 End Sub

En un caso me funcionó pero abrio el otro documento y salió el solo lectura, y en el otro no hizo nada... no pego la información

Cambiar esta línea

WordApp. Documents. Save

Por esta

WordApp. Documents. Save True

Ahora, probemos el caso cuando el archivo, sí existe y además está abierto.

Ejecuta la macro paso a paso con F8. También pon interrupciones:

Revisa exactamente por cuáles líneas pasa el código.

Si el archivo existe y además está abierto, debe pasar por esta línea:

WdDoc. Activate

Entonces analiza en qué momento te abre un nuevo libro. Si ya está abierto el archivo doc ya no debería abrir uno nuevo.

cuando llega a wdDoc. Activate me abre el archivo y sale esto

y el archivo estaba abierto 

Igualmente lo intenté con otro archivo y llega al mismo punto pero después ya no copia la información 

¿El archivo lo tienes compartido en la red?

¿Cuándo tienes abierto el archivo, lo puedes editar o solamente es de lectura?

Te hago todas esas preguntas, porque la macro que te puse, me funciona sin problema.

el archivo esta en Dropbox unicamente.... y sí puedo editarlo cuando esta abierto. Entiendo, te agradezco si puedo solucionarlo..

Incluso hay veces que me sale el mismo letrero cuando estoy editando el archivo me pide guardarlo nuevamente y es como un bucle guarda y otra vez pide lo mismo.

Tal vez es un conflicto en la versión de office y dropbox.

Intentaste probando con un archivo word pero que esté directamente en tu disco duro.

Ya acabo de probar así con el mismo archivo con una copia en mi escritorio directamente y sucedió lo mismo.. Pero cree uno nuevo y ahí si me funcionó... aunque me creo este archivo al lado ~$prueba.docx