¿Porque no ejecuta bien la macro?

Del foro, de ante mano muchas gracias, quería comentar un caso muy particular, pues he estado haciendo una macro pero a la hora de ejecutarla con un comando esta no realiza bien algunas acciones, lo revise paso a paso y por procedimientos con la ayuda del Depurador y la sorpresa que de estas dos maneras si realiza bien todas las acciones.

El problema quiero entender que es al usar la condicional IF que las anide, pues es donde no me hace bien las acciones

Les escribo el código y espero me puedan ayudar

Option Private Module
Public fin As Single
Public fin2 As Integer
Public n_polizas As Integer
Sub POLIZAS()
Application.ScreenUpdating = False

limpiamos
Polizas_unicas
autofiltro_porpolizas

Application.ScreenUpdating = True
End Sub

Sub Polizas_unicas()

fin = Range("a65536").End(xlUp).Row

Range("A3:A" & fin).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"O3"), Unique:=True
Dim limite As Object
Range("E4:E" & fin).Select
For Each limite In Selection
limite.Value = Left(limite, 50)
Next

Dim limit As Object
Range("L4:L" & fin).Select
For Each limit In Selection
limit.Value = Left(limit, 94)
Next

End Sub
Sub autofiltro_porpolizas()
'autofiltro por cuenta

On Error Resume Next
fin2 = Range("o65536").End(xlUp).Row
n_polizas = fin2 - 3
For i = 4 To fin2
ActiveSheet.Range("a3:L" & fin).AutoFilter Field:=1, Criteria1:=Range("o" & i).Value
Range("a4:L" & fin).SpecialCells(xlCellTypeVisible).Copy
Sheets("Estruc").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Hoja6.Range("M2:V2").Copy
Hoja5.[A65536].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Lines = Application.WorksheetFunction.CountA(Range("a2:a65536"))
Lines = Lines + 1
For x = 2 To Lines
If ActiveSheet.Range("BN" & x) = 0 Then
ActiveCell.Offset(1, 0).Select
Else
Hoja6.Range("X" & x & ":AE" & x).Copy
Hoja5.[A65536].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Hoja6.Range("AG" & x & ":AH" & x).Copy
Hoja5.[A65536].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End If
If ActiveSheet.Range("BO" & x) = 0 Then
ActiveCell.Offset(1, 0).Select
Else
Hoja6.Range("AJ" & x & ":AQ" & x).Copy
Hoja5.[A65536].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Hoja6.Range("AS" & x & ":AT" & x).Copy
Hoja5.[A65536].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End If
If ActiveSheet.Range("BP" & x) = 0 Then
ActiveCell.Offset(1, 0).Select
Else
Hoja6.Range("AV" & x & ":BC" & x).Copy
Hoja5.[A65536].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Hoja6.Range("BE2:BF" & Lines).Copy
Hoja5.[A65536].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End If
Next x
Hoja6.Range("BH2:BI" & Lines).Copy
Hoja5.[A65536].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Hoja6.Range("a2:L" & Lines).Clear
Hoja4.Select
Next i
Application.CutCopyMode = False
Hoja5.Range("A2:k30000").Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="Registros.xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close savechanges:=False
MsgBox ("Verificar las polizas Realizadas en Mis Documentos")
Hoja4.Select
ActiveSheet.ShowAllData
Range("A4").Select
End Sub

Sub limpiamos()

Hoja4.Range("o4:o1008").Clear
Hoja5.Cells.Delete

End Sub

Si se puede mejorar el codigo mejor

1 respuesta

Respuesta
1

Es difícil probar tu código sin tener las hojas ni algo de datos. En ocasiones mencionas las hojas como Hoja6 u Hoja5 en otras por su nombre... deberás enviármela para la revisión (*)

La particularidad de tus IF: si en BN encuentra 0 pasa a la fila siguiente. Y si luego encuentra 0 en BO vuelve a pasar a la fila siguiente... de la hoja Estruct. No parece tener sentido leyendo solo el código.

    If ActiveSheet.Range("BN" & x) = 0 Then
        ActiveCell.Offset(1, 0).Select
    Else
        Hoja6.Range("X" & x & ":AE" & x).Copy
        Hoja5.[A65536].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        Hoja6.Range("AG" & x & ":AH" & x).Copy
        Hoja5.[A65536].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    End If
    If ActiveSheet.Range("BO" & x) = 0 Then
        ActiveCell.Offset(1, 0).Select
    Else
        Hoja6.Range("AJ" & x & ":AQ" & x).Copy
        Hoja5.[A65536].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        Hoja6.Range("AS" & x & ":AT" & x).Copy
        Hoja5.[A65536].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    End If

También comentame cuál es la idea del filtro 'Polizas_unicas', estas guardando en variables datos que luego no parece utilizarse.

(*) Podes dejarme un correo tuyo escrito aquí o enviarme el libro a alguno de mis correos que aparecen en el encabezado de mi sitio.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas