VBA为每个条件自动筛选特定列，并将结果复制到新工作表中

Sub FilterAndCopy()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim rngSource As Range
    Dim rngTarget As Range
    Dim filterCriteria As Variant
    Dim lastRow As Long
    
    ' 设置源工作表和目标工作表
    Set wsSource = ThisWorkbook.Worksheets("源工作表名称")
    Set wsTarget = ThisWorkbook.Worksheets.Add
    
    ' 设置源数据范围
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    Set rngSource = wsSource.Range("A1:D" & lastRow) ' 假设数据在A到D列
    
    ' 设置筛选条件
    filterCriteria = Array("条件1", "条件2", "条件3") ' 根据实际情况修改条件
    
    ' 循环筛选并复制到目标工作表
    For Each criteria In filterCriteria
        rngSource.AutoFilter Field:=1, Criteria1:=criteria ' 根据实际情况修改筛选的列
        Set rngTarget = rngSource.SpecialCells(xlCellTypeVisible)
        rngTarget.Copy wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1)
        rngSource.AutoFilter ' 清除筛选
    Next criteria
    
    ' 调整目标工作表的列宽
    wsTarget.Columns.AutoFit
    
    ' 提示筛选和复制完成
    MsgBox "筛选和复制完成！"
End Sub