Tri liste sans doublons

[KIM]

Bonsoir le forum,

J'ai récupéré cette macro du forum, et je suis désolé car je ne sais plus sur quel fil (mes excuses pour son propriétaire).
C'est une macro qui créé une liste sans doublons à partir d'une cellule Destination sélectionnée au lancement de la macro.

J'ai besoin de votre aide pour:
1-Trier la liste sans doublons en modifiant cette macro.
2- Fixer automatiquement la cellule de destination par exemple J4?

ci-joint le fichier avec la macro UniqueListe
Merci de votre aide
Amicalement
KIM





Sub UniqueList()

Dim rListPaste As Range
Dim iReply As Integer

On Error Resume Next

Set rListPaste = Application.InputBox _
(Prompt:='Please select the destination cell', Type:=8)

If rListPaste Is Nothing Then
iReply = MsgBox('No range nominated,' _
& ' terminate', vbYesNo + vbQuestion)
If iReply = vbYes Then Exit Sub
End If

'May need to specify [NameofSheet].Range, e.g, Sheet1.Range
Feuil1.Range('A4', Range('A65536').End(xlUp)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=rListPaste.Cells(1, 1), Unique:=True


End Sub


[file name=prKIM13.zip size=16672]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/prKIM13.zip[/file]

 

[Hervé]

Bonsoir kim


Une proposition d'après un code de l'excellent _thierry :

Sub UniqueList()
'superbe idée de _thierry, merci.
Dim RangeSource As Range
Dim RangeCible As Range
        Set RangeSource = Range(Range('A5'), Range('A65536').End(xlUp))
        Set RangeCible = Range('j4')
       
       
        RangeSource.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=RangeCible, Unique:=True
        Range(Range('J4'), Range('j65536').End(xlUp)).Sort Key1:=Range('J4')

End Sub

salut

 

[KIM]

Bonjour Hervé et le forum,
Merci à toi et à _Thuerry,
Exactement ce que je souhaite,
parcontre dans la liste sans doublons et triée, j'ai 2 fois '51'.
Ce qui n'est pas le cas dans la macro initiale.
Pourqoui et comment supprimer ce dedoublement?

Je cherche toujours la solution en vba car ma liste initiale de la colonne A fait plus de 50 000 lignes.
Ci-joinnt mon fichier avec la macro proposée.
Merci d'avance
Amicalement
KIM [file name=prKIM13_20051111091843.zip size=18459]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/prKIM13_20051111091843.zip[/file]

 

[Hervé]

bonjour KiM


essaye comme ceci :

Sub UniqueList_Thierry()
'superbe idée de _thierry, merci.
Dim RangeSource As Range
Dim RangeCible As Range
                Set RangeSource = Range(Range('A4'), Range('A65536').End(xlUp))
                Set RangeCible = Range('j4')
                Range(Range('j3'), Range('j65536').End(xlUp)).Clear
                RangeSource.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=RangeCible, Unique:=True
                Range(Range('J5'), Range('j65536').End(xlUp)).Sort Key1:=Range('J5')
End Sub

salut

 

[KIM]

Bonsoir Hervé, et le forum,
ça marche bien, sans probleme.
Merci de ton aide
Bon WE
Amicalement
KIM

 

[KIM]

Bonjour Hervé et le forum,
Comme je l'ai dit, la dernière macro fonctionne correctement.

Je souhaite quand meme poser une question concernant la macro d'origine pour apprendre comment utiliser la variable dejà définié rListPaste pour faire un clear du range
qui commence à: rListPaste.Cells(1, 1)
et qui se termine avec la dernière cellule non vide du type:
rListPaste.Cells(......., 1).End(xlUp)).Clear

Merci d'avance
KIM



Sub UniqueList()

Dim rListPaste As Range
Dim iReply As Integer

On Error Resume Next

Set rListPaste = Application.InputBox _
(Prompt:='Please select the destination cell', Type:=8)

If rListPaste Is Nothing Then
iReply = MsgBox('No range nominated,' _
& ' terminate', vbYesNo + vbQuestion)
If iReply = vbYes Then Exit Sub
End If

'Comment je peux inserer un clear du range
'rListPaste.Cells(1, 1) .....rListPaste.Cells(......., 1).End(xlUp)).Clear

Feuil1.Range('A4', Range('A65536').End(xlUp)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=rListPaste.Cells(1, 1), Unique:=True


End Sub