Como copiar tablas o cuadros de Word a Excel





Hoy te presento una macro que permite importar tablas de Word a una hoja de Excel, en varias oportunidades es posible que se haya tenido que pasar tablas de Word a Excel, si son pocas no es problema se copia y pega y listo, luego se le da formato deseado y problema solucionado, pero cuando son varias, ya toma un poco más de tiempo y mucho más si esto se debe hacer todos los días en forma repetitiva; te habrás preguntado como se puede realizar automáticamente, en este ejemplo enseño como pasar tablas o cuadro de Word a Excel con solo apretar un botón.


Otros post relacionados con macros que permiten manejar Word desde Excel:
Como crear un archivo de Word con Excel
Como abrir un archivo de Word con Excel
Como conectar Excel con Word crear archivo e insertar texto en Word
Como dar formato a texto de Word desde Excel 
Como abrir modificar e imprimir archivo de Word con macro desde Excel
Como modificar una plantilla de Word con macro de Excel
Como rellenar pagare con datos de Excel conectando con Word
Como crear cartas en Word con clientes listados en Excel
Como copiar tablas o cuadros de Word a Excel


Antes de continuar recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.


  


El ejemplo se puede descargar desde el link del final en forma GRATUITA, es un archivo comprimido donde hay un archivo de Excel con la Macro y un archivo de Word con las tablas de ejemplo que se importarán a Excel, se deben descromprimir los archivos y guardar los dos juntos en cualquier carpeta de la PC, pero juntos.

La macro que permite importar tablas de Word a Excel, en primero lugar abre el archivo de Word, luego se procede a recorrer todas las tablas de Word, en en ella todas las columnas y filas que componen la tablas, pasando los datos de Word a Excel; luego de haber importado los datos de Word, procede a dar formato a las celdas de Excel.

El procedimiento descripto lo hace con todas las tablas que hubiese en Word, al final sale un mensaje mostrando la cantidad de tablas importadas, en el vídeo encontrarás una explicación más detallada y gráfica del funcionamiento de la macro, el código completo del ejemplo se encuentra al final del post.

Suscribe a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo formulario que crea un listado de todas las hojas para poder luego seleccionarlasbuscar en listbox mientras escribes en textboxordenar hojas libro excel por su nombreconectar Excel con Access y muchos ejemplos más.







Código que se inserta en un módulo




Public f, c
Sub ImportaTablaWord()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim objWord As Word.Application, wdDoc As Word.Document
Dim fila As Long, col As Long, cr As Long, conta As Integer, ti As Integer, tt As Integer
On Error Resume Next
Set a = Sheets(ActiveSheet.Name)
a.Cells.Clear
fila = 1
col = 1
conta = 0
nom = ActiveWorkbook.Name
pto = InStr(nom, ".")
nomarch = Left(nom, pto - 1)
ruta = ThisWorkbook.Path & "\" & nomarch & ".docx"
uf = a.Range("A" & Rows.Count).End(xlUp).Row
Set objWord = CreateObject("Word.Application")
objWord.DisplayAlerts = wdAlertsNone
objWord.Visible = True
Set wdDoc = objWord.Documents.Open(ruta)
With wdDoc
tt = wdDoc.Tables.Count
For x = 1 To tt
    With .Tables(x)
    For f = 1 To .Rows.Count
        For c = 1 To .Columns.Count
        a.Cells(fila, c) = WorksheetFunction.Clean(.Cell(f, c).Range.Text)
        Next c
    fila = fila + 1
    Next f
    End With
conta = conta + 1
fila = fila + 2
Call formato
Next x

End With
wdDoc.Close
MsgBox ("Se han importado " & conta & " tablas de Word a Excel"), vbInformation, "AVISO"
objWord.Quit
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Sub formato()
Dim pf As Long, uf As Long
Set a = Sheets(ActiveSheet.Name)
uf = a.Range("A" & Rows.Count).End(xlUp).Row

pf = a.Range("A" & uf).End(xlUp).Row
pc = a.Cells(f, c - c + 1).Address
pwc = Mid(pc, InStr(pc, "$") + 1, InStr(2, pc, "$") - 2)

uf = uf
uc = a.Cells(f, c - 1).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)

a.Range(pwc & pf & ":" & wc & uf).Borders(xlInsideHorizontal).LineStyle = xlContinuous
a.Range(pwc & pf & ":" & wc & uf).Borders(xlInsideVertical).LineStyle = xlContinuous
a.Range(pwc & pf & ":" & wc & pf).Borders(xlEdgeLeft).LineStyle = xlContinuous
a.Range(pwc & pf & ":" & wc & pf).Borders(xlEdgeLeft).Weight = xlMedium
a.Range(pwc & pf & ":" & wc & pf).Borders(xlEdgeTop).LineStyle = xlContinuous
a.Range(pwc & pf & ":" & wc & pf).Borders(xlEdgeTop).Weight = xlMedium
a.Range(pwc & pf & ":" & wc & pf).Borders(xlEdgeBottom).LineStyle = xlContinuous
a.Range(pwc & pf & ":" & wc & pf).Borders(xlEdgeBottom).Weight = xlMedium
a.Range(pwc & pf & ":" & wc & pf).Borders(xlEdgeRight).LineStyle = xlContinuous
a.Range(pwc & pf & ":" & wc & pf).Borders(xlEdgeRight).Weight = xlMedium


a.Range(pwc & pf + 1 & ":" & wc & uf).Borders(xlEdgeLeft).LineStyle = xlContinuous
a.Range(pwc & pf + 1 & ":" & wc & uf).Borders(xlEdgeLeft).Weight = xlMedium
a.Range(pwc & pf + 1 & ":" & wc & uf).Borders(xlEdgeTop).LineStyle = xlContinuous
a.Range(pwc & pf + 1 & ":" & wc & uf).Borders(xlEdgeTop).Weight = xlMedium
a.Range(pwc & pf + 1 & ":" & wc & uf).Borders(xlEdgeBottom).LineStyle = xlContinuous
a.Range(pwc & pf + 1 & ":" & wc & uf).Borders(xlEdgeBottom).Weight = xlMedium
a.Range(pwc & pf + 1 & ":" & wc & uf).Borders(xlEdgeRight).LineStyle = xlContinuous
a.Range(pwc & pf + 1 & ":" & wc & uf).Borders(xlEdgeRight).Weight = xlMedium

a.Range(pwc & uf & ":" & wc & uf).Borders(xlEdgeLeft).LineStyle = xlContinuous
a.Range(pwc & uf & ":" & wc & uf).Borders(xlEdgeLeft).Weight = xlMedium
a.Range(pwc & uf & ":" & wc & uf).Borders(xlEdgeTop).LineStyle = xlContinuous
a.Range(pwc & uf & ":" & wc & uf).Borders(xlEdgeTop).Weight = xlMedium
a.Range(pwc & uf & ":" & wc & uf).Borders(xlEdgeBottom).LineStyle = xlContinuous
a.Range(pwc & uf & ":" & wc & uf).Borders(xlEdgeBottom).Weight = xlMedium
a.Range(pwc & uf & ":" & wc & uf).Borders(xlEdgeRight).LineStyle = xlContinuous
a.Range(pwc & uf & ":" & wc & uf).Borders(xlEdgeRight).Weight = xlMedium

'a.Range("D" & pf + 1 & ":" & wc & uf).NumberFormat = "#,##0.00;-#,##0.00"
a.Range(pwc & pf & ":" & wc & pf).HorizontalAlignment = xlCenter
a.Range(pwc & pf & ":" & wc & pf).VerticalAlignment = xlCenter
a.Range(pwc & pf & ":" & wc & pf).Font.Size = 10
a.Range(pwc & pf & ":" & wc & pf).Font.Bold = True
a.Range(pwc & pf).RowHeight = 15

'a.Cells(uf, pwc) = "Total"
'a.Range(pwc & uf & ":" & wc & uf).Font.Bold = True

'For j = 4 To 11
'a.Cells(uf, j) = Application.WorksheetFunction.Sum(a.Range(Cells(pf + 1, j), Cells(uf - 1, j)))
'Next j

a.Range(pwc & pf & ":" & wc & pf).EntireColumn.AutoFit
End Sub



Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends