Macro para activar rutina de pendiendo del contenido de una celda

En la celda D1 tengo una lista de despliegue, dando las opciones 2014;2015;2016, quiero que según la selección se ejecute una rutina distinta, con los nombres: Ano_1, Ano_2 y Ano_3.

Estas son:

Sub Ano_1()
Application.ScreenUpdating = False
    Columns("AJ:AN").Select
    Selection.EntireColumn.Hidden = False
    Range("AC4").Select
Application.ScreenUpdating = True
End Sub
Sub Ano_2()
Application.ScreenUpdating = False
    Columns("AO:AS").Select
    Selection.EntireColumn.Hidden = False
    Range("AC4").Select
Application.ScreenUpdating = True
End Sub
Sub Ano_3()
Application.ScreenUpdating = False
    Columns("AT:AX").Select
    Selection.EntireColumn.Hidden = False
    Range("AC4").Select
Application.ScreenUpdating = True
End Sub

1 respuesta

Respuesta
2

Debes entrar al Editor de macros (con Alt y F11), seleccionar con doble clic desde el panel a tu izquierda el objeto Hoja donde vayas atrabajarlo, y al copia esta macro:

Private Sub Worksheet_Change(ByVal Target As Range)

'Solo se ejecuta en D1
If Target.Address <> "$D$1" Then exit sub
Select Case Target.value
Case 2014
Call Ano_1
Case 2015
Call Ano_2

Case 2016

Call Ano_3
End Select
End Sub

Controla el nombre de las macros y probarla. Es posible que los números de años deban ir entre comillas si se trata de valores en formato texto.

Sdos

Elsa

Hola Elsa, mil gracias por la respuesta, funciona perfecto. tengo una duda: necesito que la rutina desbloquee la hoja, después de la boquee, incluí la rutina pero no me funciona, que estoy haciendo mal?

Private Sub Worksheet_Change(ByVal Target As Range)

ActiveSheet.Unprotect Password:="XXXX"

If Target.Address <> "$D$1" Then Exit Sub

Select Case Target.Value

Case 2015

Call Ano_1

Case 2016

Call Ano_2

Case 2017

Call Ano_3

End Select

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

        , AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering _

        :=True, Password:="XXXX"

End Sub

Sub Ano_1()

Application.ScreenUpdating = False

ActiveSheet.Unprotect Password:="XXXX"

    Columns("AJ:AN").Select

    Selection.EntireColumn.Hidden = False

    Columns("AO:AX").Select

    Selection.EntireColumn.Hidden = True

    Range("AC4").Select

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

        , AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering _

        :=True, Password:="XXXX"

Application.ScreenUpdating = True

End Sub

Sub Ano_2()

Application.ScreenUpdating = False

ActiveSheet.Unprotect Password:="XXXX"

    Columns("AJ:AN").Select

    Selection.EntireColumn.Hidden = True

    Columns("AO:AS").Select

    Selection.EntireColumn.Hidden = False

    Columns("AT:AX").Select

    Selection.EntireColumn.Hidden = True

    Range("AC4").Select

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

        , AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering _

        :=True, Password:="XXXX"

Application.ScreenUpdating = True

End Sub

Sub Ano_3()

Application.ScreenUpdating = False

ActiveSheet.Unprotect Password:="XXXX"

    Columns("AJ:AS").Select

    Selection.EntireColumn.Hidden = True

    Columns("AT:AX").Select

    Selection.EntireColumn.Hidden = False

    Range("AC4").Select

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

        , AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering _

        :=True, Password:="XXXX"

Application.ScreenUpdating = True

End Sub

No agregues nuevas consultas en una ya resuelta... en casos así debes finalizarla y dejar una nueva en el tablón con su título correspondiente.

Por esta vez seguiré tratándola pero recuerda para otra ocasión.

Si la hoja va a estar protegida, la celda del desplegable debe estar sin bloqueo para que puedas seleccionarla.

Cambia el orden de la instrucción Unprotect para que no se desproteja si la celda cambiada no es D1:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$D$1" Then Exit Sub

ActiveSheet.Unprotect Password:="XXXX"

Select Case Target.Value

'sigue tu código

Luego a cada macro debes quitarle las líneas Unprotect y Protect porque ya no hacen falta.

Sdos y no olvides valorar las respuestas.

¡Gracias! Matilde quedo perfecta.

Lo tendré muy en presente.

¿Perfecta' para solo ser valoradas como 'buenas' respuestas?

Creo que yo también entonces te tendré presente salvo que modifiques tu valoración ;(

Sdos!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas