Macro para concatenar sin saber cuantas líneas
Estoy necesitando utilizar una macro para concatenar todas las líneas, pero no puedo pasarme cuando dejen de aparecer datos.
Esta fórmula utilizo para concatenar la primera fila y tirar la línea en otra hoja. Necesito que en esa nueva hoja concatene todas las filas que tengan datos debajo. No se como hacerlo.
Sheets.Add After:=Sheets(Sheets.Count)
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(Boton!R[2]C,""|"",Boton!R[2]C[2],"" "",""Num Cheque"","" "",Boton!R[2]C[3],"" "",Boton!R[2]C[4],Boton!R[2]C[5])"
En la hoja nueva deben aparecer así:
30714167894|E75997516 Num Cheque 1561263 1585709
Perdon si me expresé erroneamente.
1 respuesta
.24.05.17
Buenas, Ignacio
La siguiente rutina hace lo que pedís, independientemente de la cantidad del lineas o de números de cheques en cada una de ellas que tengas. Se detendrá cuando encuentre la primera celda vacía.
Entrá al Editor de VBA (Atajo: Alt + F11), allí insertá un módulo (Insertar-Módulo) y pegá el siguiente código:
Sub concatenator() '---- Variables modificables ---- '=== IGNACIO, modificá estos datos de acuerdo a tu proyecto: Inicelda = "A3" 'celda donde está el primer registro a concatenar HojaDest = "Hoja 2" ' Hoja donde dejar las líneas CeldaDest = "B4" 'celda donde dejar la primera fia concatenada '---- fin Variables ' ' VBA coding by FeJoAl ' '---- inicio de rutina: ' LaFila = 0 With ActiveSheet Do While Not IsEmpty(.Range(Inicelda).Offset(LaFila)) LaColu = 0 Registro = .Range(Inicelda).Offset(LaFila, LaColu).Value & "|" & .Range(Inicelda).Offset(LaFila, LaColu + 2).Value & " Num Cheque " & .Range(Inicelda).Offset(LaFila, LaColu + 3).Value LaColu = LaColu + 4 Do While Not IsEmpty(.Range(Inicelda).Offset(LaFila, LaColu)) Registro = Trim(Registro & " " & .Range(Inicelda).Offset(LaFila, LaColu).Value) LaColu = LaColu + 1 Loop Sheets(HojaDest).Range(CeldaDest).Offset(LaFila).Value = Registro LaFila = LaFila + 1 Loop End With cont = LaFila ElMensaje = IIf(cont = 0, "NO SE TRASLADO LINEA ALGUNA", "Se transfirieron: " & cont & " linea" & IIf(cont > 1, "s", "") & Chr(10) & "a la hoja " & HojaDest) TipoMens = IIf(cont = 0, vbCritical, vbInformation) ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!") Application.ScreenUpdating = True MsgBox ElMensaje, TipoMens, ElTitulo End Sub
Notarás al principio del código unas variables que podrás modificar en caso de que necesitaras cambiarlas.
.
(Buenos Aires, Argentina)
.
Hola Fernando,
probé la macro y la verdad, FUNCIONA EXCELENTE!!
muchas gracias!
Me queda la última parte y no se como configurarla bien, necesito que lo exporte a un txt, y si es posible poder configurar el nombre (desde un inputbox) y la ruta desde el macro.
Encontré esta programación, pero me cambia el nombre del excel y de la hoja, solo necesito que se aplique el nombre al txt generado en el escritorio:
Sheets(3).Select 'aqui es donde concatena las lineas con tu macro
nbre = InputBox("Ingrese Nombre del Archivo") 'INGRESO EL NOMBRE DESDE EXCEL
ruta = "D:\Users\b05021\Desktop" 'AQUI DEFINO LA RUTA DONDE GUARDARE EL ARCHIVO
'a partir de aca me pierdo, y no se porque cambia el nombre de la hoja y del libro
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=ruta & "\" & nbre & ".txt", _
FileFormat:=xlText, CreateBackup:=False
MsgBox ("Archivo generado exitosamente")
Application.ScreenUpdating = True
Espero puedas ayudarme con esta ultima parte.
Gracias!
.
Hola, Ignacio
Te armé esta subrutina para exportar la hoja creada a un archivo TXT:
Sub ExpoTXT()
'---- Variables modificables ----
'=== IGNACIO, modificá estos datos de acuerdo a tu proyecto:
HojaDest = "Hoja 2" ' Hoja donde dejar las líneas
LaCarpeta = "D:\Users\b05021\Desktop\"
'---- fin Variables
'
' VBA coding by FeJoAl
'
'---- inicio de rutina:
'
ElArchivo = InputBox("Ingrese Nombre del Archivo") 'INGRESO EL NOMBRE DESDE EXCEL
If Len(ElArchivo) > 0 Then
LaCarpeta = LaCarpeta & IIf(Right(LaCarpeta, 1) = "\", "", "\")
ElArchivo = ElArchivo & IIf(LCase(Right(ElArchivo, 4)) = ".txt", "", ".txt")
ElArchivo = LaCarpeta & ElArchivo
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets(HojaDest).Copy
ActiveWorkbook.SaveAs Filename:=ElArchivo, FileFormat:=xlText
ActiveWorkbook.Close
ThisWorkbook.Activate
MsgBox "Archivo generado exitosamente como: " & Chr(10) & ElArchivo, vbInformation, "TXT Generado"
Else
MsgBox "Nombre de archivo inválido" & Chr(10) & "Rutina termina aquí", vbCritical, "TXT NO Generado"
End If
End SubEventualmente podrías agregarla al final de la anterior, pero así funciona OK.
Abrazo
Fer
.
