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
Range("A1", Range("A65536").End(xlUp)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=rListPaste.Cells(1, 1), Unique:=True
End Sub
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
Range("A1", Range("A65536").End(xlUp)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=rListPaste.Cells(1, 1), Unique:=True
End Sub
No comments:
Post a Comment