VBA筛选数据后复制到另一张表

不需要用vba, *** 作方法如下：

1.在sheet1中先写好筛选条件，点开你文件复制的目标excel（本文是sheet2），最上面工具栏中点“数据”，找到筛选旁边的“高级”选项，跳出“高级筛选”框。

2.选中“将筛选结果复制到其他位置”，然后“列表区域”选中sheet1中的原始数据，“条件区域”选中sheet1中我们提前写好的条件，“复制到”选中sheet2中任意一个单元格（如果有要求是哪个单元格，直接点击对应单元格），“确定”。

3.结果就出来了，是不是很简单。

Private Sub CommandButton1_Click()

Sheets("Tem").Activate 'tem为原始表格

ActiveSheet.AutoFilterMode = False

Sheets("Tem").Rows("1:1").Select

Selection.AutoFilter '将原始表格设为过滤状态

Selection.AutoFilter Field:=10, Criteria1:="<1000" '选择过滤的位置，设定过滤的条件

Sheets("Tem").Range("a1").CurrentRegion.Select '选择过滤的内容

Selection.Copy Sheets("Sheet1").Range("a1") '复制选择的内容到目标表格

End Sub

你这样循环查询是不科学了，上万记录会慢死，应该一次性读出所有数据，然后去填写：

'建立已经字典，把数据库内容存入字典

set daList = CreateObject("Scripting.Dictionary")

rs.Open "select DA,B1,S1,M1,St1,R1 from `A`", conn

Do While Not rs.EOF()

     daList.Add rs(1), Array(rs(2),rs(3),rs(4),rs(5),rs(6))

     rs.MoveNext

Loop

'填写EXCEL表

for i=2 to Cells(rows.count, "D").End(xlUp).Row

    da = Cells(i,"D")

    if daList.Exists(da) then

        Cells(i,"E").resize(5,1) = daList(da)

    else

        Cells(i,"E").resize(5,1) = Empty

    end if

next i

---