使用vba自动筛选一列，并将另一列中的值放在不同的工作表中

Sub FilterAndDistributeValues()
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim rngSource As Range
    Dim rngCell As Range
    Dim varValue As Variant
    
    ' 设置源工作表和目标工作表
    Set wsSource = ThisWorkbook.Worksheets("Sheet1") ' 修改为实际的源工作表名称
    Set wsDestination = ThisWorkbook.Worksheets.Add ' 创建一个新的工作表作为目标工作表
    
    ' 设置源数据范围
    Set rngSource = wsSource.Range("A1:A" & wsSource.Cells(Rows.Count, 1).End(xlUp).Row)
    
    ' 循环遍历源数据范围
    For Each rngCell In rngSource
        varValue = rngCell.Value
        
        ' 根据值创建新的工作表，并将对应的值复制到目标工作表中
        If Not WorksheetExists(varValue) Then
            Set wsDestination = ThisWorkbook.Worksheets.Add
            wsDestination.Name = varValue
            rngCell.EntireRow.Copy wsDestination.Cells(1, 1)
        Else
            Set wsDestination = ThisWorkbook.Worksheets(varValue)
            rngCell.EntireRow.Copy wsDestination.Cells(wsDestination.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
        End If
    Next rngCell
End Sub

Function WorksheetExists(ByVal WorksheetName As String) As Boolean
    Dim ws As Worksheet
    
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(WorksheetName)
    On Error GoTo 0
    
    WorksheetExists = Not ws Is Nothing
End Function