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]
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]