VBA怎么实现excel的自动筛选

关于高级筛选，不多说，EXCEL自带，数据-筛选-高级筛选，补充一点需要注意的，筛选的时候要钩选“选择不重复记录”，另一个是EXCEL可能会自动扩大筛选范围，比如说编号同样是001，但数量不同，这时候EXCEL会认为这是两条不同的记录从而都显示出来，但我们可能只需要知道不同的编号，而不管数量。解决办法是把编号这一列同其它列用空列隔开，然后选中这一列后再便用高级筛选功能。
看你题目的意思是想把高级筛选选出来的数据重新填入另一个表中是吗？如果不是经常要用的话可以直接选中后复制粘贴，经常要用的话可以用宏，下面是我在EXCEL2003中用录制宏得到的，把表1中筛选出来的数据复制到表2中。你可以看需要改改。如果是需要高级筛选 的话你也可以录制一段宏然后加到代码里面就行了，希望可以帮到你
Sub Macro1()
'
' Macro1 Macro
' 宏由 ylc 录制，时间: 2011-5-26
'
'
Range("A1")Select
Range(Selection, SelectionEnd(xlToRight))Select
Range(Selection, SelectionEnd(xlDown))Select
SelectionCopy
Sheets("Sheet2")Select
SelectionPasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
希望能帮到你

Dim i, j, k As Integer
k = 1 'k赋初值
i = InputBox("please input the item num:") '给出总行数信息
For j = 1 To i '循环判断
If Sheets("sheet1")Cells(j, 5)Text = 1 Then '如果第5列的值等于1
Sheets("sheet1")Select
Range(Cells(j, 1), Cells(j, 5))Select '选中表1中前五列数据
SelectionCopy '复制
Sheets("Sheet2")Select '选中表2
Range(Cells(k, 1), Cells(k, 5))Select '选中表2的前5列
ActiveSheetPaste Link:=True '粘贴链接
k = k + 1 '表2行号增加
End If
Next
ApplicationCutCopyMode = False '退出复制粘贴模式 这句和下面的语句为辅助语句可删
Cells(1, 1)Select需输入总行数，希望能帮到你。

在Excel VBA中筛选数据，首先要有一个（或几个）循环For……Next或者Do……Loop来确定筛选范围；
其次，用If……Then……Else或者Select Case 语句来进行筛选（如果数据比较有规律或简单，数据量又比较大，最好用Select Case 语句，效率高点。VBA的速度实在不敢恭维）。
再次就是结果输出了（此处略去N个字）。

就是录制一个宏，如
Sub NewFilter()
Sheets("表2")Select
Sheets("表1")Range("A2:Q164")AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets _
("条件表")Range("B2:I4"), CopyToRange:=Range("A2:Q2"), Unique:=False
End Sub

筛选后求和的公式是
=SUBTOTAL(9,B2:B99)
对AB列进行筛选，筛选A列的“a”，并求和的代码如下：
Sub
xxx()
ActiveSheetRange("$A$1:$B$999")AutoFilter
Field:=1,
Criteria1:="a"
Dim
xRng
As
Range
Set
xRng
=
Range("B2:B999")
MsgBox
WorksheetFunctionSubtotal(9,
xRng)
End
Sub

一般采用倒序的方式：例如，将D列中为“否”的整行删除：
Sub
test()
For
i
=
Cells(RowsCount,
4)End(xltoup)Row
To
1
If
Range("D"
&
i)
=
"否"
Then
Range("D"
&
i)EntireRowDelete
End
If
Next
End
Sub

将Sheet1表 ，A列单元格中为Code1的所有行筛选出来，并拷贝到当前工作簿Shee2工作表
复制代码到Sheet2
Sub 筛选复制()
Dim I%
For I = 2 To Sheet1Range("A65536")End(xlUp)Row
If Sheet1Cells(I, "a") = "Code1" Then
N = N + 1
Sheet1Rows(I)Copy Cells(N + 1, "a")
End If
Next
End Sub

---