Create new list of data based on criteria

[agnesz]

I have a file with over a hundred employee names followed by their financial results. I also have 5 columns with RANK and IF conditions which highlight who ranks number 1 and who made or beat their plan. I would like to get a macro which scans this table of names and results and creates a whole new spreadsheet with the people who meet a specific criteria. I'm attaching a version of this spreadsheet to make it easier to understand.

List #1 criteria:
- List all names and "CO1" stats from column C through column L (buyer names and results) who rank 1 in column CT, rank 1 in column CU, have an X in columns CV, CW, and CX

List #2 criteria:
- List all names and "CO1" stats from column C through column L (buyer names and results) who have an X in columns CV and CW

List #3 criteria:
- List names and "CO1" stats from column C through column L (buyer names and results) who have an X in column CX

List #4 criteria:
- List names and "CO1" stats from column C through column L (buyer names and results) who have an X in column CV

[Bob Phillips]

Here is criteria 1, you should be able to work out the rest from thhis

[vba]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim iLastRow As Long
Dim cell As Range
Dim sh As Worksheet
Dim mpGMM As String
Dim mpDMM As String
Dim mpNext As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With

Set sh = ActiveSheet
On Error Resume Next
Worksheets("Criteria #1").Delete
On Error GoTo 0
Worksheets.Add
ActiveSheet.Name = "Criteria #1"

With ActiveSheet

sh.Rows(1).Copy .Range("A1")
mpNext = 2
iLastRow = sh.Cells(sh.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 2 To iLastRow 'iLastRow to 1 Step -1

If sh.Cells(i, "A").Value <> "" Then

mpGMM = sh.Cells(i, "A").Value
ElseIf sh.Cells(i, "B").Value <> "" Then

mpDMM = sh.Cells(i, "A").Value
ElseIf sh.Cells(i, "CT").Value = 1 Then

sh.Rows(i).Copy .Cells(mpNext, "A")
.Cells(mpNext, "A").Value = mpGMM
.Cells(mpNext, "B").Value = mpDMM
mpNext = mpNext + 1
End If
Next i
End With

With Application

.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub
[/vba]