VBA过滤唯一值并将这些值复制到新工作表

Sub FilterUniqueValues()
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim rngSource As Range
    Dim rngUnique As Range
    Dim cell As Range
    
    ' 设置源工作表和目标工作表
    Set wsSource = ThisWorkbook.Worksheets("源工作表名称")
    Set wsDestination = ThisWorkbook.Worksheets.Add
    
    ' 设置源数据范围
    Set rngSource = wsSource.Range("A1:A" & wsSource.Cells(Rows.Count, 1).End(xlUp).Row)
    
    ' 过滤唯一值
    rngSource.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsDestination.Range("A1"), Unique:=True
    
    ' 复制唯一值到新工作表
    Set rngUnique = wsDestination.Range("A1:A" & wsDestination.Cells(Rows.Count, 1).End(xlUp).Row)
    rngUnique.Copy
    
    ' 将唯一值粘贴到新工作表
    wsDestination.Range("B1").PasteSpecial Paste:=xlPasteValues
    
    ' 清除剪贴板内容
    Application.CutCopyMode = False
    
    ' 设置新工作表名称
    wsDestination.Name = "新工作表名称"
End Sub