# Identify number from a separate list and copy to separate sheet

#### Sharpe2026

##### New Member
I am trying to work out a way of identifying individuals in a random list as opposed to non-individuals, where each individual does have a known identifier in a separate list. And then cutting out the entire row where the individual is identified to paste into a separate sheet.

For example in the list below:

 A B C 1 26789 20 MR SMITH J BR 45327 2 26789 20 ALAN TEST TEST ALAN 55859 3 26789 40 COMPANY FNG27CI3214687564 4 26789 75 COMPANY QTG75CI39843575 5 26789 40 J JONES 0000062316

<colgroup><col span="3"><col></colgroup><tbody>
</tbody>

Rows 1, 2 and 5 are individuals, While rows 3 and 4 are companies.

In a separate works sheet I have a list of individuals and their unique identifiers:

 A B 1 J SMITH 45327 2 A TEST 55859 3 J JONES 62316 4 P HILL 64677

<colgroup><col width="64" span="3" style="width:48pt"> </colgroup><tbody>
</tbody>

So i'd like to be able to search the first list for any number contained within the second list and, where it identifies it, cut the row and paste into a third worksheet.

Si

### Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

#### mumps

##### Well-known Member
Try this macro. Change the sheet names (in red) to suit your needs.
Code:
``````Sub CopyRows()
Application.ScreenUpdating = False
Dim LastRow As Long, num As Range, desWS As Worksheet, srcWS As Worksheet, numWS As Worksheet, fnd As Range
Set srcWS = Sheets("[COLOR="#FF0000"]Sheet1[/COLOR]")
Set numWS = Sheets("[COLOR="#FF0000"]Sheet2[/COLOR]")
Set desWS = Sheets("[COLOR="#FF0000"]Sheet3[/COLOR]")
LastRow = numWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For Each num In numWS.Range("B1:B" & LastRow)
Set fnd = srcWS.Range("C:C").Find(num, LookIn:=xlValues, lookat:=xlPart)
If Not fnd Is Nothing Then
fnd.EntireRow.Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
fnd.EntireRow.Delete
End If
Next num
Application.ScreenUpdating = True
End Sub``````

#### Sharpe2026

##### New Member
Brilliant, that works perfectly!

Thank you

#### mumps

##### Well-known Member
You are very welcome.

Replies
16
Views
2K
Replies
11
Views
388
Replies
1
Views
81
Replies
1
Views
139
Replies
1
Views
133

1,130,322
Messages
5,641,529
Members
417,215
Latest member
Diaryman

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back