Para DAM adicionar nueva instrucción a macro existente

Hola DAM

Me ayudaste con esta Macro a crearla:

Sub CrearACtxt()
'Por.Dante Amor
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("AC")
    Set l2 = Workbooks.Add
    Set h2 = l2.ActiveSheet
    '
    nfact = InputBox("Favor introducir el numero de Factura a Generar: ")
    If nfact = "" Then Exit Sub
    h1.[A2] = nfact
    '
    u = h1.Range("B" & Rows.Count).End(xlUp).Row
    h1.Range("A2:M" & u).Copy h2.Range("A1")
    h2.[G1] = "10"
    h2.[h1] = "13"
    h2.Range("G1:H1").AutoFill Destination:=Range("G1:H" & u - 1)
    h2.Columns("I:K").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    h2.Columns("F:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    '
    ruta = l1.Path & "\"
    nombre = "AC000" & nfact
    l2.SaveAs Filename:=ruta & nombre & ".txt", FileFormat:=xlCSV
    '
    l2.Close
    MsgBox "Archivo TXT creado", vbInformation
    ActiveWorkbook.Save
End Sub

Me falto algo y fue que el nombre creado para el archivo TXT lo registre en una hoja llamada CT del mismo archivo en la celda "C2" por ejemplo si el archivo creado es AC000321.txt entonces que en la celda "C2" de la hoja "CT" coloque "AC000321" sin el ".txt"

Y en la celda "D2" de la hoja "CT" coloque el numero de registros contenidos en la hoja "AC" con respecto a la columna "B" empezando por la fila "2" dado a que la fila "1" son encabezados de las columnas. Es decir que cuente en la columna "B" desde la fila "2" hacia abajo cuantos registros hay y ese valor lo coloque en la celda "D2" de la hoja "CT"

Gracias y espero me halla podido hacer entender bien.

1 Respuesta

Respuesta
1

Te regreso la macro con los cambios

Sub CrearACtxt()
'Por.Dante Amor
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("AC")
    Set l2 = Workbooks.Add
    Set h2 = l2.ActiveSheet
    '
    nfact = InputBox("Favor introducir el numero de Factura a Generar: ")
    If nfact = "" Then Exit Sub
    h1.[A2] = nfact
    '
    u = h1.Range("B" & Rows.Count).End(xlUp).Row
    h1.Range("A2:M" & u).Copy h2.Range("A1")
    h2.[G1] = "10"
    h2.[h1] = "13"
    h2.Range("G1:H1").AutoFill Destination:=Range("G1:H" & u - 1)
    h2.Columns("I:K").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    h2.Columns("F:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    '
    ruta = l1.Path & "\"
    nombre = "AC000" & nfact
    l2.SaveAs Filename:=ruta & nombre & ".txt", FileFormat:=xlCSV
    '
    l2.Close
    l1.Sheets("CT").[C2] = nombre
    l1.Sheets("CT").[D2] = u - 1
    '
    MsgBox "Archivo TXT creado", vbInformation
    ActiveWorkbook.Save
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas