Para DANTE AMOR error Autofill en código de Macro
Hola DAM
Tengo un inconveniente con una Macro que me ayudaste a construir pero que solo me esta funcionando si tengo 2 o más filas diligenciadas de datos, pero si solo tengo 1 sola fila de datos no me quiere funcionar.
¿Me ayudarías a revisarla a ver que es lo que sucede?
La macro es esta:
Sub CrearAPtxt()
'Por.Dante Amor
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("AP")
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:L" & u).Copy h2.Range("A1")
h2.[G1] = "2"
h2.[h1] = "2"
h2.[I1] = "1"
h2.Range("G1:I1").AutoFill Destination:=Range("G1:I" & u - 1)
h2.Columns("K:L").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'
ruta = l1.Path & "\"
nombre = "AP000" & nfact
l2.SaveAs Filename:=ruta & nombre & ".txt", FileFormat:=xlCSV
'
l2.Close
u2 = l1.Sheets("CT").Range("A" & Rows.Count).End(xlUp).Row + 1
l1.Sheets("CT").Cells(u2, "A") = "'682760382901"
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 SubTe mando igualmente la imagen del archivo.
Agradezco me puedas ayudar.
Si te das cuenta, la celda A3 esta en rojo hacia abajo, eso es por que tengo una fórmula allí que es:
=SI(B3="";"";A2)
No se si sea esa fórmula la que esta causando el error.
1 Respuesta
Respuesta de Dante Amor
1
Esta es la macro completa
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"
u = h2.Range("B" & Rows.Count).End(xlUp).Row
If u > 1 Then
h2.Range("G1:H1").AutoFill Destination:=Range("G1:H" & u)
End If
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
'
MsgBox "Archivo TXT creado", vbInformation
ActiveWorkbook.Save
End SubSaludos.Dante Amor
No olvides valorar la respuesta.
Hola DANTE
Es que son dos macros diferentes, muy parecidas pero con instrucciones distintas. Una se llama CrearACtxt y ota se llama CrearAPtxt.
Me hiciste la de CrearACtxt corregida pero necesito es la de CrearAPtxt
Que pena molestar tanto
No es ninguna molestia, te anexo la macro
Sub CrearAPtxt()
'Por.Dante Amor
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("AP")
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:L" & u).Copy h2.Range("A1")
h2.[G1] = "2"
h2.[h1] = "2"
h2.[I1] = "1"
u2 = h2.Range("B" & Rows.Count).End(xlUp).Row
If u2 > 1 Then
h2.Range("G1:I1").AutoFill Destination:=Range("G1:I" & u)
End If
h2.Columns("K:L").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'
ruta = l1.Path & "\"
nombre = "AP000" & 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, "A") = "'682760382901"
l1.Sheets("CT").Cells(u2, "B") = "'" & Format(Date, "dd/mm/yyyy")
l1.Sheets("CT").Cells(u2, "C") = nombre
l1.Sheets("CT").Cells(u2, "D") = u2
MsgBox "Archivo TXT creado", vbInformation
ActiveWorkbook.Save
End Sub
Perdona, considera la siguiente macro
Sub CrearAPtxt()
'Por.Dante Amor
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("AP")
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:L" & u).Copy h2.Range("A1")
h2.[G1] = "2"
h2.[h1] = "2"
h2.[I1] = "1"
u1 = h2.Range("B" & Rows.Count).End(xlUp).Row
If u1 > 1 Then
h2.Range("G1:I1").AutoFill Destination:=Range("G1:I" & u1)
End If
h2.Columns("K:L").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'
ruta = l1.Path & "\"
nombre = "AP000" & 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, "A") = "'682760382901"
l1.Sheets("CT").Cells(u2, "B") = "'" & Format(Date, "dd/mm/yyyy")
l1.Sheets("CT").Cells(u2, "C") = nombre
l1.Sheets("CT").Cells(u2, "D") = u1
MsgBox "Archivo TXT creado", vbInformation
ActiveWorkbook.Save
End Sub
