Question

表格VBA中从数据库提取信息，整行导出

Sheet1是我的数据库 Sheet3的D段是选择条件
当Sheet3的D段和Sheet1的G段相同时 请把Sheet1对应的整行导出到Sheet4 并且去掉Sheet4中的空白行
求高手指点

Answer 1

高级筛选不就好了

 Sub shaixuan() 
Sheets("Sheet4").rows("2:10000").clearcontents
sheets("sheet1").Range("A:X").AdvancedFilter Action:=xlFilterCopy, criteriarange:=Worksheets("Sheet3").Range("D1:Dn"), copytorange:=Worksheets("sheet4").Range("A2"), unique:=False  'D1:Dn改为实际范围
MsgBox "筛选完毕"
End Sub

追问

我把你这段代码放到sheet1里面 结果一运行 整个sheet1都跑到sheet4去了 不是我想要的效果

追答

那是因为你的问题 描述不清， 问题 清楚了，就解决了
至少 要 图片说明你表格的样式，

高级筛选 的条件 区域 (Sheet3 D 列 ） 标题 要与Sheet1 G 列标题一致， 条件 列出需要的项次, 你可以自己 百度下 ，我也不想慢慢给你解释

Answer 2

用拷贝吧
Sub text()
On Error Resume Next
Application.ScreenUpdating = False
arr = Range("g2:g" & [g65536].End(3).Row)
Set d = CreateObject("Scripting.dictionary")
For i = 1 To UBound(arr)
d(arr(i, 1)) = i + 1
Next
brr = Sheet3.Range("d2:d" & Sheet3.[d65536].End(3).Row)
For i = 1 To UBound(brr)
If d.exists(brr(i, 1)) Then
k = d(brr(i, 1))
Rows(k).Copy Sheet4.Cells(Sheet4.[a65536].End(3).Row + 1, "a")
End If
Next
End Sub