estimado @pinoji
la verdad sin archivo es dificil de hacer pruebas, deberias de adjuntar aunque sea un pequeño ejemplo:
te mando el codigo corregido, (Nota: sin realizar pruebas)
Sub InsertarCuentaOrdenada()
Dim wsCatalogo As Worksheet
Dim ultimaFila As Long
Dim nivelCuenta As String
Dim nuevaCuenta As String
Dim tituloCuenta As String
Dim naturalezaCuenta As String
Dim i As Long
Dim filaInsertar As Long
Dim cuentaEncontrada As Boolean
Set wsCatalogo = ThisWorkbook.Sheets("Plan de Cuentas")
ultimaFila = wsCatalogo.Cells(wsCatalogo.Rows.Count, 1).End(xlUp).Row
' Pedir datos
nivelCuenta = InputBox("Ingrese la categoría jerárquica de la cuenta:")
nuevaCuenta = InputBox("Ingrese el código de la nueva cuenta (ej: 102-03):")
tituloCuenta = InputBox("Ingrese el Título de la cuenta:")
naturalezaCuenta = InputBox("Ingrese la Naturaleza de la cuenta (D/H):")
cuentaEncontrada = False
filaInsertar = ultimaFila + 1 ' Por defecto, al final
' Buscar dónde insertar
For i = 3 To ultimaFila
If wsCatalogo.Cells(i, 1).Value = nivelCuenta Then
If wsCatalogo.Cells(i, 2).Value > nuevaCuenta Then
filaInsertar = i
cuentaEncontrada = True
Exit For
End If
End If
Next i
' Insertar fila y datos
wsCatalogo.Rows(filaInsertar).Insert Shift:=xlDown
wsCatalogo.Cells(filaInsertar, 1).Value = nivelCuenta
wsCatalogo.Cells(filaInsertar, 2).Value = nuevaCuenta
wsCatalogo.Cells(filaInsertar, 3).Value = tituloCuenta
wsCatalogo.Cells(filaInsertar, 4).Value = naturalezaCuenta
MsgBox "Cuenta insertada correctamente y ordenada.", vbInformation
End Sub
Código original
Insertaba la nueva cuenta justo debajo de la primera coincidencia de jerarquía (columna A).
No respetaba el orden numérico de los códigos de cuenta (columna B).
Resultado: cuentas nuevas podían quedar fuera de orden lógico (ej: 102-03 podía quedar arriba de 102-02).
Código corregido
Busca todas las cuentas con la jerarquía indicada.
Compara el código de la nueva cuenta con los existentes y encuentra su posición correcta dentro de esa jerarquía.
Inserta la cuenta en ese punto, manteniendo el orden numérico.
Espero haberte ayudado,
Saludos,
Por
DiegoLG , · publicado el sábado a las 20:26 4 días
Buen dia
Recuerro a ustedes papar poder validar el correcto cierre del ciclo de esta macro.
El ciclo afectado es el FOR que tiene la variable n debe trabajar hasta el 23, pero cuando llega a 24, sigue con el ciclo de numero1 y de suma y continua trabajando con errores.
como puedo hacer para que la n al llegar a 24 finalice la macro y no realice las demas actividades ? ya movi los Next pero no lo he logrado, espero me puedan dar una guia
Gracias
esta es la macro
Sub Union()
'
Dim fila, RR As Long
Dim n&, cCriterio$, H&, g&, y&
fila = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
j = 5
y = 1
For H = 5 To 23
Dim aCol, t&, LE$
aCol = Array("E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y")
For t = LBound(aCol) To UBound(aCol)
LE = aCol(t)
For n = j To 23
If n = j Then cCriterio = "<>0" Else cCriterio = "0"
ActiveSheet.Range("$A$11:$AH$" & fila).AutoFilter Field:=n, Criteria1:=cCriterio
' numero1
Range("A12").Select
ActiveCell.FormulaR1C1 = y
Range("B12").Select
Selection.End(xlDown).Select
Range("A" & fila).Select
ActiveCell.FormulaR1C1 = y
Range("A" & fila).Select
Selection.Copy
Range(Selection, Selection.End(xlUp)).Select
Selection.Resize(Selection.Rows.Count + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.End(xlUp).Select
ActiveWindow.SmallScroll Down:=-24
RR = fila - 11
'MsgBox RR
'suma
Range(LE & 10).Select
Range(Selection, Selection.End(xlDown)).Select
Range(LE & 11).Select
Selection.End(xlDown).Select
Range(LE & fila).Select
Application.CutCopyMode = False
ActiveCell.Formula = "=SUBTOTAL(9," & LE & "12:" & LE & Selection.Row - 1 & ")"
Range(LE & fila).Select
Selection.Copy
Selection.End(xlUp).Select
Range(LE & 9).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next n
j = j + 1
n = j
y = y + 1
Rows("11:11").Select
ActiveSheet.ShowAllData
Range("A10").Select
Next t
Next H
End Sub
Gracias
Ciclo.xlsm