Excel 2007, копирование строк с одного листа на другой на основе значения в 1 столбце

Я пытаюсь скопировать диапазон строк, где выбранные строки основаны на значении в одной ячейке. Я хочу сделать это для всех строк, содержащих одно и то же значение в ячейке, а затем перейти к следующему значению и добавить к внизу первого списка.

Ниже моя попытка объяснить, чего я хочу достичь - надеюсь, вышеизложенное поможет объяснить мою дилемму. Я искал это, но не совсем нашел то, что хочу. Я думал, что это будет просто, и, вероятно, это так.

Я получаю дамп данных с тысячами строк данных и 18 столбцами. Основываясь на значении столбца P «Контракт», я хочу скопировать целые строки в новый отдельный рабочий лист workingdata. Не все данные попадут на рабочий лист workingdata.

Номера контрактов: c1234, c1235, c2345 и т. д.

То, что я достиг, — это копирование и сортировка, поэтому скопируйте все строки данных, где номер контракта — c1234, в workingdata, затем непосредственно под ним скопируйте все строки, где контракт — c1235, и так далее.

Я думал, что смогу выбрать диапазон P:P и отсортировать, но безрезультатно.

Sheets("Data Dump").Select
Columns("P:P").Select
If Selection.Value = "C1234" Then
Selection.EntireRow.copy

Я знаю, что должен опубликовать то, что я пробовал, но это было бы жалко, по какой-то причине я просто не могу понять это.

Вот моя последняя попытка - я знаю, что есть ошибки

Dim oWorksheet As Excel.Worksheet
Dim oRangeSource As Excel.Range
Dim oRangeDest As Excel.Range

Set oWorksheet = Worksheets("DataDump")
Set oRangeSource = oWorksheet.Range("p:p")
Set oRangeDest = Worksheets("workingdata")

If oRangeSource="CA0004000" Then Select.EntireRow

Selection.EntireRow.copy
Sheets("workingdata").Select.Paste
End If

последнее усилие, но не сортирует данные и не избавляется от нежелательных, я должен выполнить ручной фильтр и сортировку, которые побеждают объект макроса

Sub copy()
'
' copy Macro
'
Dim rngContracts As Range:      Set rngContracts = Sheets("DataDump").Range("P:P")
Dim wsData As Worksheet

Dim wsFound As Boolean: wsFound = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    If ws.Name = "Working Data" Then
        Set wsData = ws
        wsFound = True
        Exit For
    End If
Next ws

If wsFound = False Then
    Application.CutCopyMode = False
    ActiveSheet.Range("A1").EntireRow.copy
    Set wsData = Sheets.Add(After:=Sheets(Sheets.Count))
    wsData.Name = "Working Data"
    wsData.Range("A1").EntireRow.PasteSpecial xlPasteAll, Transpose:=False
End If

Dim iCell As Range
For Each iCell In rngContracts
    If iCell.EntireRow.Hidden = False Then
        Application.CutCopyMode = False
        iCell.EntireRow.copy
        wsData.Range("P" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.PasteSpecial xlPasteAll, Transpose:=False
    End If
Next iCell

Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Последняя попытка - копирует нужные мне данные, но не сортирует:

Sub copytest()
'
' copytest Macro
'
Set MR = Sheets("data Dump").Range("P:P")

    For Each cell In MR

If cell.Value = "CA000154" Then
cell.EntireRow.copy
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial

    End If

If cell.Value = "CA000220" Then
cell.EntireRow.copy
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
    End If
If cell.Value = "CA000393" Then
cell.EntireRow.copy
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
    End If
If cell.Value = "CA000429" Then
cell.EntireRow.copy
Sheets("working data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
    End If
Application.CutCopyMode = False

Next

End Sub