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

Respuesta
1

.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 Sub

Eventualmente podrías agregarla al final de la anterior, pero así funciona OK.

Abrazo

Fer

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas