Macro para insertar cuentas contables en 400 rubros distintos y que esta resalte en verde las nuevas agregadas en excel
Respecto a la consulta anterior la macro funciona perfectamente donde insertan todas las cuentas nuevas en mis 400 rubros, mi consulta es hay posibilidades de que resalte en verde las nuevas cuentas que se agregan y también si se puede agregar una opción de eliminar en caso de error, ¿qué elimine de una vez las nuevas cuentas agregadas en los 400 rubros?
1 respuesta
Hola Dante, así mismo, la macro que me creaste es para insertar las nuevas cuentas en los 400 rubros, pero ahora en caso que me equivoque en el código, existiría la forma de limpiar "borrar" de vuelta lo que se insertó y que tome lectura siempre la misma columna E y si se puede colorear en verde las nuevas cuentas que se insertaron desde la A a la DE,
Saludos
Te adelanto el cambio la macro InsertarCuentas para poner en color verde las cuentas nuevas:
Sub InsertarCuentas()
Dim lr As Long, i As Long, lr2 As Long
Dim rubro As Variant
'
Application.ScreenUpdating = False
lr = Range("A" & Rows.Count).End(3).Row + 1
lr2 = Range("E" & Rows.Count).End(3).Row - 1
Range("A" & lr).Value = "CC"
'
For i = lr To 5 Step -1
If Range("A" & i).Value = "CC" And Range("A" & i - 1).Value = "Cta" Then
rubro = Range("B" & i - 1).Value
Range("A" & i & ":D" & i + lr2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A" & i & ":A" & i + lr2).Value = "Cta"
Range("B" & i & ":B" & i + lr2).Value = rubro
Range("C" & i & ":D" & i + lr2).Value = Range("E1:F" & lr2 + 1).Value
Range("A" & i & ":D" & i + lr2).Interior.Color = vbGreen
End If
Next
Range("A" & Rows.Count).End(3).Value = ""
Application.ScreenUpdating = True
End SubDame tiempo para preparar la otra macro para eliminar cuentas.
Muchas gracias Dante, esta perfecto lo pasa en verde,
saludos
Te paso la macro para borrar cuentas.
Las columnas C y E deben ser tipo texto. Al final son cuentas y no se utilizan para hacer operaciones.
Sub Borrar_Cuentas()
'Por Dante Amor
Dim i As Long, lr As Long, lr2 As Long
Dim ctas() As Variant
'
Application.ScreenUpdating = False
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
Range("C:C, E:E").NumberFormat = "@"
lr = Range("A" & Rows.Count).End(3).Row + 1
lr2 = Range("E" & Rows.Count).End(3).Row
'
For i = 1 To lr2
ReDim Preserve ctas(1 To i)
ctas(i) = Range("E" & i).Text
Next
ActiveSheet.Range("A5:D" & lr).AutoFilter Field:=3, Criteria1:=Array(ctas), Operator:=xlFilterValues
Range("A6:A" & lr).EntireRow.Delete
ActiveSheet.ShowAllData
Application.ScreenUpdating = True
End Sub
