Buenos días, soy nuevo en estoy de programar en excel, tengo un macro de evento de una lista desplegable, la cual si se le inserta un valor que no esta en la lista lo agrega automáticamente, aquí esta el código
Private Sub Worksheet_Change(ByVal Target As Range)
Bien esto funciona bien cuando se tiene una sola lista, pero cuando se tiene varias lista no se como hacer para que funcione, intente duplicar la rutina pero me tira un error,
Private Sub Worksheet_Change(ByVal Target As Range)
Buenos días, soy nuevo en estoy de programar en excel, tengo un macro de evento de una lista desplegable, la cual si se le inserta un valor que no esta en la lista lo agrega automáticamente, aquí esta el código
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$D$5" Then Exit Sub
On Error Resume Next
fil = Application.WorksheetFunction.Match(Target, Sheets("Hoja2").Columns("B:B"), 0)
If fil <> "" Then Exit Sub
uf = Sheets("Hoja2").Range("B" & Cells.Rows.Count).End(xlUp).Row + 1
Sheets("Hoja2").Range("B" & uf) = Target
Sheets("Hoja2").Range("B5:B" & uf).Sort Key1:=Sheets("Hoja2").Range("B5"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
End Sub
Bien esto funciona bien cuando se tiene una sola lista, pero cuando se tiene varias lista no se como hacer para que funcione, intente duplicar la rutina pero me tira un error,
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$D$5" Then Exit Sub
On Error Resume Next
fil = Application.WorksheetFunction.Match(Target, Sheets("Hoja2").Columns("B:B"), 0)
If fil <> "" Then Exit Sub
uf = Sheets("Hoja2").Range("B" & Cells.Rows.Count).End(xlUp).Row + 1
Sheets("Hoja2").Range("B" & uf) = Target
Sheets("Hoja2").Range("B5:B" & uf).Sort Key1:=Sheets("Hoja2").Range("B5"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$D$9" Then Exit Sub
On Error Resume Next
fil = Application.WorksheetFunction.Match(Target, Sheets("Hoja2").Columns("D:D"), 0)
If fil <> "" Then Exit Sub
uf = Sheets("Hoja2").Range("D" & Cells.Rows.Count).End(xlUp).Row + 1
Sheets("Hoja2").Range("D" & uf) = Target
Sheets("Hoja2").Range("D5:D" & uf).Sort Key1:=Sheets("Hoja2").Range("D5"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
End Sub
subo el archivo, mas adelante se agregarán como 10 o 20 listas entonces no se como hacer para que se active dependiendo de la celta.
Gracias de antemano
ListaDiferenteHoja.rar