Exportar tablas de Excel a formato TXT con VBA
Quisiera que me ayudaran con lo siguiente, tengo una serie de tablas llenas de información de clientes, y debo generar una serie de reportes los cuales debo exportar por txt, se hacerlo por el panel, pero necesito exportarla a través de código VBA, con delimitación tabulada y que el nombre que vaya a almacenar lo tome del titulo de la tabla. Gracias por el apoyo y la orientación. Felices fiestas
1 respuesta
Si tus tablas son un rango de celdas pero en tabla y las tablas las tienes en una hoja, ejecuta la siguiente macro en esa hoja. El nombre del archivo será el nombre de la tabla.
Sub ExportarTablas() 'Por.Dante Amor Application.DisplayAlerts = False Application.ScreenUpdating = False ruta = ThisWorkbook.Path & "\" ' For Each t In ActiveSheet.ListObjects Set l2 = Workbooks.Add Set h2 = l2.Sheets(1) t.Range.Copy h2.[A1] l2.SaveAs Filename:=ruta & t.Name & ".txt", FileFormat:=xlText, CreateBackup:=False l2.Close Next End Sub
Hola muchas gracias por responder, sucede lo siguiente, tengo una hoja en excel donde ingresa la información y esta lleva el contenido a una tabla donde vacía la información, yo debo generar un reporte con ciertos campos de la tabla por ejemplo mi tabla es de 15 columnas y 100 filas. El reporte lo debo generar uno que contenga los campos $A1-100, $C1-100, $H1-100, $L1-100 y así sucesivamente, al exportarlo debe exportarlo con delimitación tabulada y con los campos que seleccione. El nombre del archivo txt debe tener el nombre de la tabla
Eso hace la macro, exporta la tabla a txt.
Envíame tu archivo de excel y me explicas paso a paso, cómo haces la exportación, también envíame el archivo txt que obtienes como resultado, de esa forma podré entender lo que necesitas.
Así quedó la macro para enviar carácter por carácter de cada columna de cada fila.
Sub Macro5()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Tabla_Datos_Nominados")
Set l2 = Workbooks.Add
Set h2 = ActiveSheet
ruta = l1.Path
'
L1. Activate
H1. Columns(3). Copy h2. Columns(1)
H1. Columns(4). Copy h2. Columns(2)
H1. Columns(5). Copy h2. Columns(3)
H1. Columns(6). Copy h2. Columns(4)
H1. Columns(7). Copy h2. Columns(5)
H1. Columns(10). Copy h2. Columns(7)
H1. Columns(12). Copy h2. Columns(8)
H1. Columns(13). Copy h2. Columns(9)
H1. Columns(15). Copy h2. Columns(10)
H1. Columns(24). Copy h2. Columns(11)
H1. Columns(26). Copy h2. Columns(12)
H1. Columns(17). Copy h2. Columns(13)
H1. Columns(19). Copy h2. Columns(14)
H1. Columns(20). Copy h2. Columns(15)
H1. Columns(50). Copy h2. Columns(16)
H1. Columns(51). Copy h2. Columns(17)
H1. Columns(52). Copy h2. Columns(18)
H1. Columns(56). Copy h2. Columns(19)
H1. Columns(39). Copy h2. Columns(20)
H1. Columns(40). Copy h2. Columns(21)
H1. Columns(41). Copy h2. Columns(22)
H1. Columns(42). Copy h2. Columns(23)
H1. Columns(43). Copy h2. Columns(24)
H1. Columns(46). Copy h2. Columns(25)
H1. Columns(37). Copy h2. Columns(26)
H1. Columns(38). Copy h2. Columns(27)
H1. Columns(48). Copy h2. Columns(28)
H1. Columns(49). Copy h2. Columns(29)
H1. Columns(35). Copy h2. Columns(30)
H1. Columns(62). Copy h2. Columns(31)
H1. Columns(2). Copy h2. Columns(32)
For i = 1 To h1.Range("G" & Rows.Count).End(xlUp).Row
h2.Cells(i, 6) = h1.Cells(i, 5) & " " & h1.Cells(i, 6) & " " & h1.Cells(i, 7) & " " & h1.Cells(i, 8)
Next
h2.Rows("1:8").Delete Shift:=xlUp
'
l2.Activate
FileNum = FreeFile()
nbre = "nuevo"
Open ruta & "\" & nbre & ".txt" For Output As #FileNum
'
cols = Array(0, 1, 9, 35, 35, 35, 45, 1, 1, 2, 8, 3, 3, 3, 3, 30, 11, 11, 22, 1, 5, 40, 5, 30, 4, 1, 5, 30, 10, 5, 26, 4, 3)
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
For j = 1 To 32
dato = Cells(i, j)
Select Case j
Case 2: dato = Format(Cells(i, j), "000000000")
Case 15, 16, 17: dato = Format(Cells(i, j), "00000000000")
End Select
For k = 1 To cols(j)
car = Mid(dato, k, 1)
If car = "" Then car = " "
Print #FileNum, car;
Next
Next
Print #FileNum,
Next
Close #FileNum
l2.Close False
'
MsgBox "Archivo txt generado"
End Sub
