Para DANTE AMOR incluir unas instrucciones a una macro existente
Hola DANTE
Ejecute una macro que me ayudaste a crear pero después de ejecutarla me di cuenta que me faltaron unas cositas adicionales que me gustaría que me pudieras colaborar con eso. La macro esta perfecta pero me gustaría adicionarle a lo que ya hace, una serie de instrucciones más.
Te envío la macro que tenemos para que te guíes de ella:
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 SubEsto es lo que ya tenemos. Lo que ahora necesito que me ayudes a adicionales a esta macro es lo siguiente.
En ese mismo archivo también tengo una hoja llamada "CT" quisiera que en la celda "B2" de la hoja "CT" se coloque la fecha en la que ejecutó la macro (esta macro) en la forma "DD/MM/AAAA" pero en formato TEXTO. Ejemplo 27/11/2014
En esta misma hoja "CT" colocar el "nombre" del archivo que creamos (sin el ".txt") y se coloque ese nombre en la celda "C2" de la hoja "CT" ejemplo: "AC000321"
En la siguiente celda es decir en la "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"
Espero me halla hecho entender bien.
Y gracias de antemano.
1 Respuesta
Te anexo 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").[B2] = "'" & Format(Date, "dd/mm/yyyy")
l1.Sheets("CT").[C2] = nombre
l1.Sheets("CT").[D2] = u - 1
'
MsgBox "Archivo TXT creado", vbInformation
ActiveWorkbook.Save
End SubPero, tengo la siguiente duda, en la siguiente ejecución quieres que los datos de fecha, archivo y número de registros queden otra vez en la fila 2 o que se pongan en la fila vacía siguiente? , si es así, de una vez te pongo la macro.
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
'
u2 = l1.Sheets("CT").Range("B" & Rows.Count).End(xlUp).Row + 1
l1.Sheets("CT").Cells(u2, "B") = "'" & Format(Date, "dd/mm/yyyy")
l1.Sheets("CT").Cells(u2, "C") = nombre
l1.Sheets("CT").Cells(u2, "D") = u - 1
'
MsgBox "Archivo TXT creado", vbInformation
ActiveWorkbook.Save
End Sub
