¿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