记得有位吧友曾经问过这样的问题，能不能将数据每个条件的筛选结果，导出到新的工作表中，现在这希VBA代码，就是用来实例此功能。数据区域为当前单元格所在的区域，而条件按当前单元格所在列的每一个不同项导出，导出的工作表名为条件名称。

Sub CopyAllFilter()
Dim XSH As Worksheet, TSH As Worksheet
Dim TRan As Range
Dim i As Integer, FN As Integer
Dim PD As Boolean
Dim Down As VbMsgBoxResult
Down = MsgBox("当前单元格应该在数据区域中" & vbCrLf & "并且按当前单元格所在列筛选" & vbCrLf & "       是否继续？", vbYesNo, "提示")
If Down = vbNo Then Exit Sub
Set XSH = ActiveSheet
PD = XSH.AutoFilterMode
If PD = False Then XSH.UsedRange.AutoFilter
Set TRan = ActiveCell.CurrentRegion
FN = ActiveCell.Column - TRan.Item(1).Column + 1
For i = 2 To TRan.Rows.Count
    If WorksheetFunction.CountIf(Range(TRan.Item(1).Cells(1, FN), TRan.Item(1).Cells(i, FN)), TRan.Item(1).Cells(i, FN)) = 1 Then
        Set TSH = Sheets.Add(after:=ActiveSheet)
        TSH.Name = TRan.Item(1).Cells(i, FN)
        XSH.Select
        XSH.UsedRange.AutoFilter field:=FN, Criteria1:=TRan.Item(1).Cells(i, FN)
        TRan.SpecialCells(xlCellTypeVisible).Copy
        TSH.Select
        TSH.Paste
        XSH.Select
    End If
Next
If PD = False Then XSH.UsedRange.AutoFilter
End Sub