Crear una lista a partir de otra eliminando repetidos y ordenando alfabéticamente
Hola actualmente tengo una macro que toma una lista, la ordena, elimina los repetidos e inserta en otra hoja en una lista desplegable.
Lo que necesito ahora es que esta misma macro me cree la misma lista en otra columna de esta hoja, necesito que quede en ('Resultado'!AA2)
Adjunto la macro actual.
Ojala pueda ser esto dentro de la misma macro para usar solo un botón
De antemano muchas gracias!
Sub solos()
Sheets("Reporte por Ejecutivo y por Día").Select
Range("b2").Select
Range(Selection, Selection.End(xlDown)).Copy Destination:=Range("ce1")
Range("ce1", Range("ce1").End(xlDown)).Select
Selection.Sort key1:=Range("ce1"), order1:=xlAscending, Header:=xlNo, ordercustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("ce1").Select
Do While ActiveCell.Value <> ""
If InStr(valor, ActiveCell) = 0 Then
valor = valor & "," & ActiveCell
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("ce1", Range("ce1").End(xlDown)).ClearContents
Range("b2").Select
valor = Mid(valor, 2, Len(valor) - 1)
Sheets("Resultados").Select
Range("C25").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=valor
End With
Range("c25").Select
End Sub
1 respuesta
Sustituye la linea:
Range("C25").Select
por esta:
Range("AA2").select
Gracias por la respuesta amigo, pero, lo que necesito es que ADEMAS lo cree en AA2
Y que esta segunda sea una lista hacia abajo, no desplegable
Gracias!
La macro completa sería esta:
Sub solos()
Sheets("Reporte por Ejecutivo y por Día").Select
Range("b2").Select
Range(Selection, Selection.End(xlDown)).Copy Destination:=Range("ce1")
Range("ce1", Range("ce1").End(xlDown)).Select
Selection.Sort key1:=Range("ce1"), order1:=xlAscending, Header:=xlNo, ordercustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("ce1").Select
Do While ActiveCell.Value <> ""
If InStr(valor, ActiveCell) = 0 Then
valor = valor & "," & ActiveCell
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("ce1", Range("ce1").End(xlDown)).ClearContents
Range("b2").Select
valor = Mid(valor, 2, Len(valor) - 1)
valor = Split(valor, ",")
Sheets("Resultados").Select
For f = 0 To UBound(valor)
Range("aa2").Select
ActiveCell.Value = valor(f)
ActiveCell.Offset(1, 0).Select
Next
End Sub
Amigo, entendiste perfecto lo que quise hacer, pero la macro solo me escribe el ultimo dato de los que ordena, no me crea la lista completa.
Te agradezco mucho la solución
Ahora está bien:
Sub solos()
Sheets("Reporte por Ejecutivo y por Día").Select
Range("b2").Select
Range(Selection, Selection.End(xlDown)).Copy Destination:=Range("ce1")
Range("ce1", Range("ce1").End(xlDown)).Select
Selection.Sort key1:=Range("ce1"), order1:=xlAscending, Header:=xlNo, ordercustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("ce1").Select
Do While ActiveCell.Value <> ""
If InStr(valor, ActiveCell) = 0 Then
valor = valor & "," & ActiveCell
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("ce1", Range("ce1").End(xlDown)).ClearContents
Range("b2").Select
valor = Mid(valor, 2, Len(valor) - 1)
valor = Split(valor, ",")
Sheets("Resultados").Select
Range("aa2").Select
For f = 0 To UBound(valor)
ActiveCell.Value = valor(f)
ActiveCell.Offset(1, 0).Select
Next
End Sub
Me acabo de dar cuenta de otra necesidad.
Es posible que me limpie, antes de colocar la lista que crea el rango (AA11:AA1000)
De nuevo muchas gracias!
claro... después de la linea:
Sheets("Resultados").Select
Pon esto:
Range("AA11:AA1000"). Clearcontents
...
...
