Ayuda con una macro de correspondencia

[jeaa]

Buenas tardes, expertos  tengo un archivo de Excel con macro dentro del libro tengo  dos hojas una se llama Principal y la otra se llama Consolidar, bien en la hoja principal hay tres botones nuevo, importar y crear documentos; el botón nuevo limpia las hojas asignadas, también en el botón importar  une bien los datos de los libros guardado en la carpeta Data, esto lo copia en la hoja Consolidar todo bien, pero cuando pulso el botón crear documento crea los documentos tanto en word y pdf pero no termina se queda congelado la macro; por favor me puede ayudar a ver en que parte de la macro esta haciendo conflicto, por lado si me puede ayudar a que los documentos creados se guarden en la carpeta Reporte y por ultimo que también una copia de los documentos se guarden en formato Excel. Por favor ayúdenme los agradeceré bastante.

Adjunto los archivos encriptados en formato rar.

Correspondencia.rar

[JasallBcn]

Buenas, La generación de documentos parece que se queda colgada porque lo que Tiene 199 filas para generar ...

 Por un lado, puedes comprobar si existen datos antes de realizar la llamada a la creación de los documentos.     

  If fila.Range(1, 1) <> "" Then ' comprobar que hay datos
        datosEmpleado.nombre = fila.Range(1, 1)
        datosEmpleado.puesto = fila.Range(1, 2)
        datosEmpleado.fechaInicio = fila.Range(1, 3).Text
        datosEmpleado.fechaFin = fila.Range(1, 4).Text
        Call crearDoc(datosEmpleado)
       End If

Cuando copias los datos a la hoja1 , cambialo por :

Sub concatenar() ' solo copiar los registros
Dim Cont As Long
Cont = 2
Do While Hoja2.Range("J" & Cont).Value <> ""
 Hoja2.Range("J" & Cont).Copy
 Hoja1.Range("B" & Cont + 6).PasteSpecial xlPasteValues
 Hoja2.Range("B" & Cont).Copy
 Hoja1.Range("C" & Cont + 6).PasteSpecial xlPasteValues
 Hoja2.Range("C" & Cont).Copy
 Hoja1.Range("D" & Cont + 6).PasteSpecial xlPasteAll
 Hoja2.Range("D" & Cont).Copy
 Hoja1.Range("E" & Cont + 6).PasteSpecial xlPasteAll
 Cont = Cont + 1
Loop
Application.CutCopyMode = False

y el sub limpiar  (borrara los 200 registros):

Sub limpiar()
Hoja2.Range("A2:D100").ClearContents
If Hoja1.Range("B8").Value <> "" Then
 Worksheets("Principal").Range("Datos").Delete
End If
End Sub

para guardar en reporte :

RutaCarpeta = Range("RutaCarpeta").Value & "Reporte\"

pero debes copiar el archivo word ejemplo en el directorio Reporte.

lo de copiar guardar una copia en excel es mas complejo, puedes buscar alguna rutina para convertir en word a excel , o puedes generarlo desde la macro  usando una plantilla  excel

suerte