Excel 2007, Copying rows from one sheet to another based on a value in 1 column

Question

I'm trying to copy a range of rows where the rows chosen are based on the value in one cell.I want to do this for all rows containing the same value in a cell, then move on to the next value an append to the bottom of the first list.

Below is my attempt at explaining what I wish to achieve - hopefully the above will help explain more my dilemma. I have looked around for this but not quite found what I want. I thought it would be simple and probably is.

I receive a data dump with thousands of rows of data and 18 columns. Based on the value of column P "Contract" I want to copy entire rows into a new single worksheet workingdata . Not all the data will go into the workingdata worksheet.

The contract numbers are c1234, c1235, c2345 etc.

What i am after achieving is copying and sorting, so copy all the rows of data where contract number is c1234, in workingdata , then directly below it copy all rows where contract is c1235 and so on.

I thought I could select the range P:P and sort but to no avail.

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

I know I should post what i have tried, but it would be a pathetic, for some reason I just can't seem to get my head round this one.

Here's my latest effort - I know there are errors

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

latest effort but does not sort data or get rid of unwanted, I have to do a manual filter and sort which sorts of defeats the object of the macro

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

Latest attaempt - copies the data I need but does not sort:

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

Answer 1

Record a macro to set filters on your data select one filter only.

Then, edit the code and loop through each filter copying the visible range on to your sheet. This must also sort your data as the filters are already sorted.

Also, take a look at creating filter arrays in the Excel VBA help with regards to using them to sort.