Generar txt con macro en excel
Las siguiente macro es para generar un archive txt desde excel, me funciona al 100, solo que quiero que en la columna L, me haga un salto de linea con la informacion y que siga recorriendo, buscando informacion. Auxilio ayuda ya me e quebrado la cabeza y no doy..:)
Sub pasar()
Dim ruta As String
Dim ubica As String
Dim lista As String
ruta = ActiveWorkbook.Path & "\"
Open ruta & "caritxt.txt" For Output As #1
Range("a6", ["s6"]).Select
Do While ActiveCell.Offset(0, 1).Value <> ""
ubica = ActiveCell.Address
Do While ActiveCell.Column < 21
If ActiveCell.Value <> "false" Then
lista = lista & "|" & ActiveCell.Value
End If
ActiveCell.Offset(0, 1).Select
Loop
lista = Mid(lista, 2, Len(lista) - 1)
Print #1, lista
lista = ""
Range(ubica).Offset(1, 0).Select
Loop
Range("a9", ["h9"]).Select
Do While ActiveCell.Offset(0, 1).Value <> ""
ubica = ActiveCell.Address
Do While ActiveCell.Column < 10
If ActiveCell.Value <> "false" Then
lista = lista & "|" & ActiveCell.Value
End If
ActiveCell.Offset(0, 1).Select
Loop
lista = Mid(lista, 2, Len(lista) - 1)
Print #1, lista
lista = ""
Range(ubica).Offset(1, 0).Select
Loop
Range("A12").Select
Do While ActiveCell.Offset(0, 1).Value <> ""
ubica = ActiveCell.Address
Do While ActiveCell.Column < 52
If ActiveCell.Value <> "false" Then
lista = lista & ENTER & "|" & ActiveCell.Value
End If
ActiveCell.Offset(0, 1).Select
Loop
lista = Mid(lista, 2, Len(lista) - 1)
Print #1, lista
lista = ""
Range(ubica).Offset(1, 0).Select
Loop
Close #1
MsgBox "Se ha creado el txt en la ruta: " & ruta
End Sub
1 respuesta
H o l a:
Te anexo la macro actualizada, revisa si es lo que necesitas.
Sub pasar()
'
Application.ScreenUpdating = False
Dim ruta As String
Dim ubica As String
Dim lista As String
ruta = ActiveWorkbook.Path & "\"
Open ruta & "caritxt.txt" For Output As #1
Range("a6", ["s6"]).Select
Do While ActiveCell.Offset(0, 1).Value <> ""
ubica = ActiveCell.Address
Do While ActiveCell.Column < 21
'act.Por.Dante Amor
If ActiveCell.Column = Columns("L").Column Then
Print #1, lista
lista = ""
End If
'Fin.Por.Dante Amor
If ActiveCell.Value <> "false" Then
lista = lista & "|" & ActiveCell.Value
End If
ActiveCell.Offset(0, 1).Select
Loop
lista = Mid(lista, 2, Len(lista) - 1)
Print #1, lista
lista = ""
Range(ubica).Offset(1, 0).Select
Loop
'
Range("a9", ["h9"]).Select
Do While ActiveCell.Offset(0, 1).Value <> ""
ubica = ActiveCell.Address
Do While ActiveCell.Column < 10
If ActiveCell.Value <> "false" Then
lista = lista & "|" & ActiveCell.Value
End If
ActiveCell.Offset(0, 1).Select
Loop
lista = Mid(lista, 2, Len(lista) - 1)
Print #1, lista
lista = ""
Range(ubica).Offset(1, 0).Select
Loop
'
Range("A12").Select
Do While ActiveCell.Offset(0, 1).Value <> ""
ubica = ActiveCell.Address
Do While ActiveCell.Column < 52
'act.Por.Dante Amor
If ActiveCell.Column = Columns("L").Column Then
Print #1, lista
lista = ""
End If
'Fin.Por.Dante Amor
If ActiveCell.Value <> "false" Then
lista = lista & ENTER & "|" & ActiveCell.Value
End If
ActiveCell.Offset(0, 1).Select
Loop
lista = Mid(lista, 2, Len(lista) - 1)
Print #1, lista
lista = ""
Range(ubica).Offset(1, 0).Select
Loop
'
Close #1
MsgBox "Se ha creado el txt en la ruta: " & ruta
End Sub‘
S a l u d o s . D a n t e A m o r
Si es lo que necesitas. Recuerda valorar la respuesta. G r a c i a s.
