Código vba para copiar varias hojas de excel con determinados rangos a un documento en word, al hacer clic en un botón.
Tengo el siguiente código que me exporta muy bien la información de excel a word para una hoja, sin embargo la necesito para otras 6 hojas con rangos establecidos, podrían ayudarme. Gracias
Sub Exportar_Click()
On Error Resume Next
Dim Wordapn As Object
'el archivo Word se guarda en la misma ruta que el archivo Excel
ruta = ThisWorkbook.Path
'rango a copiar
Sheets("ReqNut").Range("A1:H23").Copy
'crear nueva aplicación Word
Set Wordapn = CreateObject("Word.Application")
'nombre del archivo word, puede hacer referencia a una celda u otro dato
n_archivo = "mi_doc_word"
With Wordapn
.Visible = True
.Activate
End With
'crear nuevo documento Word
Wordapn.Documents.Add
'pegar celdas Excel
Wordapn.Selection.Paste
'guardar como
Wordapn.ActiveDocument.SaveAs ruta & "\" & n_archivo & ".doc"
'liberar el objeto Word
Set Wordapn = Nothing
End Sub
3 Respuestas
Hola muchas gracias por tu ayuda, la necesito en el mismo word, Gracias.
Te anexo la macro actualizada, cambia hoja2, hoja3, hoja4, hoja5, hoja6 y hoja7 por los nombres de tus hojas y el rango que quieras copiar
Sub Exportar_Click()
'Act.Por.Dante Amor
On Error Resume Next
Dim Wordapn As Object
'Crear documento Word
Set Wordapn = CreateObject("Word.Application")
With Wordapn
.Visible = True
.Activate
End With
Wordapn. Documents. Add
'
'rango a copiar
Sheets("ReqNut"). Range("A1:H23"). Copy
Wordapn. Selection. Paste
Wordapn. Selection.TypeText "" & Chr(13)
Sheets("Hoja2"). Range("A1:H23"). Copy
Wordapn. Selection. Paste
Wordapn. Selection.TypeText "" & Chr(13)
Sheets("Hoja3"). Range("A1:H23"). Copy
Wordapn. Selection. Paste
Wordapn. Selection.TypeText "" & Chr(13)
Sheets("Hoja4"). Range("A1:H23"). Copy
Wordapn. Selection. Paste
Wordapn. Selection.TypeText "" & Chr(13)
Sheets("Hoja5"). Range("A1:H23"). Copy
Wordapn. Selection. Paste
Wordapn. Selection.TypeText "" & Chr(13)
Sheets("Hoja6"). Range("A1:H23"). Copy
Wordapn. Selection. Paste
Wordapn. Selection.TypeText "" & Chr(13)
Sheets("Hoja7"). Range("A1:H23"). Copy
Wordapn. Selection. Paste
Wordapn. Selection.TypeText "" & Chr(13)
'Guardar
ruta = ThisWorkbook.Path
n_archivo = "mi_doc_word"
Wordapn.ActiveDocument.SaveAs ruta & "\" & n_archivo & ".doc"
'liberar el objeto Word
Set Wordapn = Nothing
End SubSaludos.Dante Amor
Recuerda valorar la respuesta.
¡Gracias! el código me ha funcionado de maravilla muchísimas gracias por su aporte del cual he aprendido mucho.
Bendiciones
Lo rápido sería cambiar
Sheets("ReqNut"). Range("A1:H23"). Copy
Por los demás rangos de las hojas cambiarlos a mano en la sub.
Si quieres hacerlo con una sub. Te pongo lo que saldría con el ejemplo que has dado.
Private Sub cmdExportar_datos_Click()
Call exportar("ReqNut","A1:H23")
'Otros ejemplos
'call exportar("ReqMoo","A1:H45")
End Sub
Sub Exportar(Nombre_Hoja as string, Rango as string)
On Error Resume Next
Dim Wordapn As Object
'el archivo Word se guarda en la misma ruta que el archivo Excel
ruta = ThisWorkbook.Path
'rango a copiar
Sheets(Nombre_Hoja).Range(Rango).Copy
'crear nueva aplicación Word
Set Wordapn = CreateObject("Word.Application")
'nombre del archivo word, puede hacer referencia a una celda u otro dato
n_archivo = "mi_doc_word"
With Wordapn
.Visible = True
.Activate
End With
'crear nuevo documento Word
Wordapn.Documents.Add
'pegar celdas Excel
Wordapn.Selection.Paste
'guardar como
Wordapn.ActiveDocument.SaveAs ruta & "\" & n_archivo & ".doc"
'liberar el objeto Word
Set Wordapn = Nothing
End Sub
El código me funciona perfectamente, habrá modo de que en lugar de generarse varios word, sea solo en uno, toda esa información de esas hojas?
Muchas gracias por tu ayuda
Sub Exportar(Nombre_Hoja as string, Rango as string)
On Error Resume Next
Dim Wordapn As Object
'el archivo Word se guarda en la misma ruta que el archivo Excel
ruta = ThisWorkbook.Path
'crear nueva aplicación Word
Set Wordapn = CreateObject("Word.Application")
'nombre del archivo word, puede hacer referencia a una celda u otro dato
n_archivo = "mi_doc_word"
With Wordapn
.Visible = True
.Activate
End With
'crear nuevo documento Word
Wordapn.Documents.Add
'----------------------------------------------------------------------
'Añade todos los datos que quieras aquí
'Copias rango
'Pegas rango
'Así con todos los datos, después lo guardas
'rango a copiar
Sheets(Nombre_Hoja).Range(Rango).Copy
'pegar celdas Excel
Wordapn.Selection.Paste
'
'---------------------------------------------------------------------
'guardar como
Wordapn.ActiveDocument.SaveAs ruta & "\" & n_archivo & ".doc"
'liberar el objeto Word
Set Wordapn = Nothing
End Sub
Sr Dante. Por favor quisiera guardar mi copia de word con su respectivo nombre que existe en la celda b7 en excel, que proviene .Pero no me ha funcionado, aqui le dejo mi macro:
Mi correo:[email protected]
Gracias de antemano
Sub Copiar_a_Word_inter()
Range("a1:f64").Select
'-------------------------------------------------------------
Dim WordApp2013 As Object
Set WordApp2013 = CreateObject("Word.Application.15")
Selection.Copy
With WordApp2013
'‘Con este codigo se abrira Word y se creara un documento nuevo
.Visible = True
.Activate
.documents.Add
End With
WordApp2013.Selection.PasteSpecial link:=True
'‘Se pegara en el documento lo seleccionado en la hoja de calculo
Set WordApp2013 = Nothing
'Guardar
' no me sale guardar con su nombre !
End Sub