Put a shape on Sheet 2 with this macro assigned to it: MyWb.xlsm!'CopyRow Thisworkbook.worksheets("Sheet2").cells(1,1)'
The name of your workbook needs to be 'MyWb'..... or change it in the line of code above.
On Sheet 2, put a part # into A1.
Click the shape and it'll call this sub:
Sub CopyRow(PartNum As Long)
Dim WsOne As Worksheet
Dim WsTwo As Worksheet
Dim LastRowWithData As Long
Dim r As Long
Set WsOne = ThisWorkbook.Worksheets("Sheet1")
Set WsTwo = ThisWorkbook.Worksheets("Sheet2")
LastRowWithData = WsOne.Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
For r = 1 To LastRowWithData
If WsOne.Cells(r, 1) = PartNum Then
WsOne.Rows(r).Copy WsTwo.Rows(3)
MsgBox "Part Number " & PartNum & " has been copied."
Exit Sub
End If
Next r
MsgBox "Sorry, Part Number " & PartNum & " not found."
End Sub
Bookmarks