Cambiar mi macro para que realice lo que necesito
Le comento esta macro que tengo me convierte los archivos a, TXT pero los deja con espacios me gustaría que los separe por punto y coma
Les dejo la macro
Sub generar_texto()
Dim intUltimaFila As Long
Application.ScreenUpdating = False
ActiveSheet.Copy
intUltimaFila = Columns("A:A").Range("A65536").End(xlUp).Row
For r = intUltimaFila To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
Range("A1").Select
nbre = InputBox("Nombre del archivo")
ruta = "C:\Users\75070\Desktop" 'AQUI DEBES DEFINIR LA RUTA DONDE GUARDARAS TU ARCHIVO
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=ruta & "\" & nbre & ".txt", _
FileFormat:=xlText, CreateBackup:=False
ActiveWorkbook.Close
MsgBox ("Archivo generado exitosamente")
Application.ScreenUpdating = True
End Subla macro anterior lo realiza de esta forma
pero me gustaria que quedara de esta otra manera
Alguien podría ayudarme.
1 Respuesta
Prueba con la siguiente macro
Private Sub Exportar_a_Txt()
'Por.Dante Amor
Application.ScreenUpdating = False
nbre = InputBox("Nombre del archivo")
If nbre = "" Then Exit Sub
'
ActiveSheet.Copy
intUltimaFila = Columns("A:A").Range("A65536").End(xlUp).Row
For r = intUltimaFila To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
'
nFileNum = FreeFile
ruta = "C:\Users\75070\Desktop\" 'AQUI DEBES DEFINIR LA RUTA DONDE GUARDARAS TU ARCHIVO
'ruta = ThisWorkbook.Path & "\"
rutaarchivo = ruta & nbre & ".txt"
Set h = ActiveSheet
Open rutaarchivo For Output As #nFileNum
nfilas = h.Range("A" & Rows.Count).End(xlUp).Row
ncolumnas = Columns("F").Column
For i = 1 To nfilas
For j = 1 To ncolumnas
Select Case j
Case 3: dato = Format(h.Cells(i, j), "dd/mm/yyyy")
Case 6: dato = Format(h.Cells(i, j), "#,##0.00")
Case Else: dato = h.Cells(i, j)
End Select
salida = salida & dato & ";"
Next j
If salida <> "" Then
salida = Left(salida, Len(salida) - 1)
End If
Print #nFileNum, salida
salida = Empty
Next i
ActiveWorkbook.Close False
Close #nFileNum
MsgBox "Archivo generado exitosamente"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Me marca que la macro no esta disponible y no se ejecuta puede que este deshabilitado
Cambia esta línea
Private Sub Exportar_a_Txt()
Por esta
Sub Exportar_a_Txt()
Ejecuta la macro Exportar_a_txt
Sal u dos
Muchas gracias quedo excelente se lo agradezco una pregunta se podría modificar para que automáticamente determine las columnas que tienen información porque hasta ahorita solo llega hasta la columna f si pongo más información tengo que cambiar la letra de la columna
Cambia esta línea
ncolumnas = Columns("F").ColumnPor esta:
ncolumnas = Cells(1, Columns.Count).End(xlToLeft).Column
sal u dos
