macros，从列表中的项目中select一个单元名称并在另一个表格中find它

我是VBA中的新手，我想编写一个程序，当我从列表中手动select一个或多个项目时，代码将使用项目的名称进行search并从另一个工作表中选取，复制整行并将其粘贴到第三个片。 那可能吗？ 最好通过点击button进行select。 非常感谢！

Answer 1

这是一个例子。

Sub FindAndMove() Dim Finder As Range Dim TheItem As Variant With Sheets("Sheet1") If Selection.CountLarge = 1 And Not Intersect(Selection, .Range("A2:A11")) Is Nothing Then TheItem = Selection.Value Else MsgBox ("Please select an item from the list") Exit Sub End If End With With Sheets("Sheet2") Set Finder = .Range("A:A").Find(TheItem, LookAt:=xlWhole) If Finder Is Nothing Then MsgBox ("Item not found!") Exit Sub End If With Sheets("Sheet3") Finder.EntireRow.Copy .Range("A" & .UsedRange.Rows.CountLarge + 1) .Select 'Optional - show sheet 3 End With End With End Sub 

遍历代码：

当他们点击button时，如果他们只select我们列表中的1个单元格。

获取他们select的项目的价值

在Sheet2 – 在列Afind该值

如果find它，则将整行复制到Sheet3的末尾

您可以通过将Sheet("Sheet1")的图纸名称更改为任何您想要的来修改代码。

您也可以通过更改.Range("A2:A11")来更改列表范围

您可以通过更改.Range("A:A")来更改search范围

第1页：

第2页：

第3页:(select第3项后点击查找和移动）

error handling：

编辑：

使用FindNext查找多个事件的代码

 Sub FindAndMove() Dim Finder As Range Dim FirstAddress As Variant Dim TheItem As Variant With Sheets("Sheet1") If Selection.CountLarge = 1 And Not Intersect(Selection, .Range("A2:A11")) Is Nothing Then TheItem = Selection.Value Else MsgBox ("Please select an item from the list") Exit Sub End If End With With Sheets("Sheet2") Set Finder = .Range("A:A").Find(TheItem, LookAt:=xlWhole) If Finder Is Nothing Then MsgBox ("Item not found!") Exit Sub End If FirstAddress = Finder.Address Do With Sheets("Sheet3") Finder.EntireRow.Copy .Range("A" & .UsedRange.Rows.CountLarge + 1) End With Set Finder = .Range("A:A").FindNext(Finder) Loop While Not Finder Is Nothing And Finder.Address <> FirstAddress End With Sheets("Sheet3").Select 'Optional - Select Sheet3 After. End Sub