Excel - Ayuda para macro que pase valores variables de rangos de excel e insertarlos en un template de word

Sub Exportar_Word()

    Dim Contador As Long, PathArch, ObjWord, Document, i, TextoBuscar, fso

    ' ---&---  Ocultamos el procedimiento

     Application.ScreenUpdating = False

     Contador = 0

    ' ---&---  Le indicamos que los datos han de salir de la página "CSV"

     Sheets("CSV").Select

    Dim datos(0 To 1, 0 To 2) As String '(columna,fila)

    ' ---&---  Le indicamos el nombre de la plantilla de Word

    PathArch = ThisWorkbook.Path & "\StoryDesignTemplate.dotx"

    ' ---&---  Pasamos a una variable, la ruta donde se guardaran los documentos de Word

     Ruta = ActiveWorkbook.Path

    ' ---&---  Creamos una carpeta dónde se encuentra este excal epara guardar dentro todos los Words y le llamamos "Informes"

     MkDir (Ruta & "\Informes")

    ' ---&---  Creamos el Objeto Word que debería ser oculto y sin abrir el programa 'Word'

    Set ObjWord = CreateObject("Word.Application")

    ObjWord.Visible = False

    ObjWord.Documents.Add Template:=PathArch, NewTemplate:=False, DocumentType:=0

    ' ---&---  Creamos la orden para generar un "documento" sin abrir Word

    Set Document = word.Documents.Add()    ' <--- Word no existe

    Document.SaveAs (Filename)             ' <--- No tiene contenido Filename

    ' ---&---  Indicamos las variables de la plantilla de Word y la correspondencia de rango de la 'Sheet' CSV importada

    ' 

    '          Primero: a este grupo de lineas les faltaban las comillas a las referencias.

    '          Segundo: No se que sentido tiene rellenar 499 lineas con estos textos.

    '          Tercero: cuando se lee el fichero InfoOrigen_CSV.csv

    ' 

    Range("B2:B500") = "[info_StoryID]"

    Range("D2:D500") = "[info_TitleStory]"

    Range("E2:E500") = "[info_Assignee]"

    Range("F2:F500") = "[info_Component]"

    Range("H2:H500") = "[info_Fix_H]"

    Range("I2:I500") = "[info_Fix_I]"

    Range("J2:J500") = "[info_Fix_J]"

    Range("K2:K500") = "[info_Fix_K]"

    Range("L2:L500") = "[info_Fix_L]"

    Range("M2:M500") = "[info_Fix_M]"

    Range("N2:N500") = "[info_Fix_N]"

    Range("O2:O500") = "[info_StoryPoints]"

    Range("P2:P500") = "[info_EpicID]"

    Range("Q2:Q500") = "[info_Sprint_Q]"

    Range("R2:R500") = "[info_Sprint_R]"

    Range("S2:S500") = "[info_Sprint_S]"

    Range("T2:T500") = "[info_Sprint_T]"

    Range("U2:U500") = "[info_Sprint_U]"

    For i = 0 To UBound(datos, 2)

        TextoBuscar = datos(0, i)

        ObjWord.Selection.Move 6, -1

        ObjWord.Selection.Find.Execute FindText:=TextoBuscar

        While ObjWord.Selection.Find.found = True

            ObjWord.Selection.Text = datos(1, i) 'texto a reemplazar

            ObjWord.Selection.Move 6, -1

            ObjWord.Selection.Find.Execute FindText:=TextoBuscar

        Wend

    Next i

    ObjWord.Activate

    ' ---&---  Si el fichero no existe, entonces lo creamos

    If Not fso.FolderExists(Ruta & "Informes" & ActiveCell.Value) Then

        fso.CreateFolder (Ruta & "Informes" & ActiveCell.Value)

        Contador = Contador + 1

    End If

    ' ---&---  Pasamos a la fila siguiente, y volvemos a recorrer el bucle

     ActiveCell.Offset(1, 0).Select

    Loop ' <-- este comando está aquí solo sin ningún sentido

    ' ---&---  Limpiamos el objeto

     Set fso = Nothing

    ' ---&---  Mostramos el procedimiento

     Application.ScreenUpdating = True

    ' ---&---  Mensaje de texto de creación de carpetas

    Respuesta = MsgBox("Se han generado " & Contador & " informes con éxito" & vbCrLf & _

                                                                               vbCrLf & _

                        "Se encuentras dentro de la carpeta 'Informes'", _

                        64, _

                        "Workstreams - Creación de informes a diseñar")

End Sub