Copying between worksheets using a Lookup?

[DJ]

Hello,

Looking for assistance on using VBA to copy entire rows from one
worksheet to another based on criteria contained in a third worksheet.

I have a workbook containing sales records by salesperson. The
salesperson's name is listed in column 1. I would like to
programmatically copy entire rows from this worksheet (up to 65,000
rows) to a new worksheet in the same workbook based on the salesperson's
name. I would like to be able to list the salesperson's names in a third
worksheet and have the macro copy only the rows of the salespeople
listed on this third worksheet. The list of sales people could change
each time the macro is run, so the macro would need to dynamically refer
to this list of salespeople.

I've done some light VBA programming in the past but I'm not sure how to
approach this problem. From what I've read, vlookup may be part of the
solution, but again I'm not clear on how to implement this.

Any ideas, suggestions or examples would be appreciated. Thanks!

 

[Guest]

The code below should work. I assume there were no header rows in your
speadsheet. Adjustment would have to be made in code if there are heders.
Also I assume the Salespeople Names were in Column A (both 1st and last).
You also may have to change the constants for the sheet names to match your
worksheet.

Sub copysalepeople()

'AS abbreviation for All SalesPeople
Const ASP = "Sheet1"
'SSP abbreviation for SelectedSalesPeople
Const SSP = "Sheet2"
'SS abbreviation for SelectedSales
Const SS = "Sheet3"


SSPLastRow = Sheets(SSP).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(SSP).Activate
Set SSPNames = Sheets(SSP).Range(Cells(1, 1), Cells(SSPLastRow, 1))

ASPLastRow = Sheets(ASP).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(ASP).Activate
Set ASPNames = Sheets(ASP).Range(Cells(1, 1), Cells(ASPLastRow, 1))

SSRowCount = 1
For Each SSPCell In SSPNames

For Each ASPCell In ASPNames

If (StrComp(SSPCell, ASPCell) = 0) Then

Sheets(ASP).Cells(ASPCell.Row, 1).EntireRow.Copy _
Destination:=Sheets(SS).Cells(SSRowCount, 1)
SSRowCount = SSRowCount + 1

End If

Next ASPCell


Next SSPCell

End Sub

 

[DJ]

Your example worked great! As promised, the only tweeks needed were for
sheet names and columns. Other than that it was copy & paste Thanks for
sharing this with me!

DJ