如何用VBA去实现EXCEL的表中找到符合条件的单元格,然后再整行复制到另一个表

如题所述

给你一个工作表事件代码,你可以参考使用:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error Resume Next
Dim a As String, b As String, x As Integer, y As Integer
Dim rng As Range
y = Sheets(3).[a65536].End(3).Row
If Target <> "" And Target.Column = 1 Then
a = "*" & Target & "*"
With Sheets(2)
For Each rng In .UsedRange
If rng Like a = True Then
x = rng.Row
y = y + 1
.Range(x & ":" & x).Copy Destination:=Sheets(3).Range("A" & y)
End If
Next
End With
End If
Application.ScreenUpdating = True
End Sub
这个代码的功能是在表1的A列输入数值,自动查找表二中对应A列数值然后事先复制到表三。

欢迎到Excel Home论坛学习、交流”。
温馨提示:答案为网友推荐,仅供参考
第1个回答  2012-01-25
myvalue = InputBox("请输入要查找的值:")
Set myrange = Cells.Find(myvalue)
Rows(myrange.Row).Copy Destination:=Sheets("sheet1").Range("A1")

具体要复制到哪个表格你自己改吧
第2个回答  2012-01-25
给你一个工作表事件代码,你可以参考使用:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error Resume Next
Dim a As String, b As String, x As Integer, y As Integer
Dim rng As Range
y = Sheets(3).[a65536].End(3).Row
If Target <> "" And Target.Column = 1 Then
a = "*" & Target & "*"
With Sheets(2)
For Each rng In .UsedRange
If rng Like a = True Then
x = rng.Row
y = y + 1
.Range(x & ":" & x).Copy Destination:=Sheets(3).Range("A" & y)
End If
Next
End With
End If
Application.ScreenUpdating = True
End Sub
这个代码的功能是在表1的A列输入数值,自动查找表二中对应A列数值然后事先复制到表三。

欢迎到Excel Home论坛学习、交流”,谢谢!本回答被网友采纳
相似回答