Copy cells containing specific values into another column skipping blanks

Question

I have a list of issues in column B and their associated status in column C. I want to copy only the issues that have a status of "Ready for Testing", "Build in Prod", "In Progress" or "Awaiting CAB Approval" to column D and do not want blank cells in between.

I have slightly modified the code found in this topic but cannot get it working for the four different status types (I tried adding in ElseIf statements but that did not seem to work):

Copy all cells with certain value into another column skipping blanks

Sub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1

'--> Loop through each cell in column C
'--> Add each cell in column B with value "Ready for Testing" in column B to 
NewRange
For Each cell In Worksheets("OverviewTest").Range("C6:C56")
    If cell.Value = "Ready for Testing" Then
        If MyCount = 1 Then Set NewRange = cell.Offset(0, -1)
        Set NewRange = Application.Union(NewRange, cell.Offset(0, -1))
        MyCount = MyCount + 1
    End If
Next cell

'--> Copy NewRange from inactive sheet into active sheet
NewRange.Copy Destination:=ActiveSheet.Range("D6")


End Sub

Thanks in advance for any assistance with this, I am very new to Excel VBA.

Update 02/06/2017

I have created a simplified version of my file for a demonstration of what I am trying to achieve. My original file has many tabs, with many more columns and hundreds of rows per tab. (Apologies, it will not allow me to add multiple images so I have had to upload one big image)

Sheet2 - Contains the all detail about the jobs

Sheet1 - I am looking for this to be the Overview tab only displaying active jobs. Column A contains hyperlinks to the changes in Sheet 2. Column F has conditional formatting that is removed if cells are copied so I have used a VLOOKUP instead

When I run the original script from Tom or Scott (with a separate loop for column D and E) the detail gets copied correctly, but the hyperlinks do not get copied. When I run the new script, column E gets copied correctly but column D and F do not for some reason. I think the original script would work for column E but for column D, is there a method to preserve the hyperlinks? https://i.stack.imgur.com/clR2b.jpg

Original script

Sub RangeCopyPaste()
Dim cell As Range
Dim NewChangeRange As Range
Dim NewDetailRange As Range


Set NewChangeRange = Range("D6") 'Set the first destination cell

For Each cell In Worksheets("Sheet1").Range("C6:C14") 'Loop through your Status column
    Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
        Case "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
            NewChangeRange.Value = cell.Offset(0, -2).Value 'In the destination cell, take the cell value 1 column to the left of the cell which contained the required status
            Set NewChangeRange = NewChangeRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
    End Select
Next cell


Set NewDetailRange = Range("E6") 'Set the first destination cell

For Each cell In Worksheets("Sheet1").Range("C6:C14") 'Loop through your Status column
    Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
        Case "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
            NewDetailRange.Value = cell.Offset(0, -1).Value 'In the destination cell, take the cell value 1 column to the left of the cell which contained the required status
            Set NewDetailRange = NewDetailRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
    End Select
Next cell

End Sub

New script

Sub RangeCopyPaste()
    Dim cell As Range
    Dim NewChangeRange As Range
    Dim NewDetailRange As Range


    Set NewChangeRange = Range("D6") 'Set the first destination cell

    For Each cell In Worksheets("Sheet1").Range("C6:C14") 'Loop through your Status column
        Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
            Case "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
                Range(cell.Offset(0, -2), cell.Offset(0, -2)).Copy NewChangeRange
                Set NewChangeRange = NewChangeRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
        End Select
    Next cell


    Set NewDetailRange = Range("E6") 'Set the first destination cell

    For Each cell In Worksheets("Sheet1").Range("C6:C14") 'Loop through your Status column
        Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
            Case "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
                NewDetailRange.Value = cell.Offset(0, -1).Value 'In the destination cell, take the cell value 1 column to the left of the cell which contained the required status
                Set NewDetailRange = NewDetailRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
        End Select
    Next cell

    End Sub

Answer 1

Take advantage of Case statement here. See below.

Sub RangeCopyPaste()

Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1

'--> Loop through each cell in column C
'--> Add each cell in column B with value "Ready for Testing" in column B to 

For Each cell In Worksheets("OverviewTest").Range("C6:C56")

    Select Case cell.Value 

        Case is = "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval"

            If MyCount = 1 Then 
                Set NewRange = cell.Offset(0, -1)
            Else
               Set NewRange = Application.Union(NewRange, cell.Offset(0, -1))
            End If

            MyCount = MyCount + 1

    End Select

Next cell

'--> Copy NewRange from inactive sheet into active sheet
NewRange.Copy Destination:=ActiveSheet.Range("D6")


End Sub

Answer 2

Try the code below to resolve your issue;

Sub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range

Set NewRange = Range("D1") 'Set the first destination cell

For Each cell In Worksheets("Sheet1").Range("C1:C16") 'Loop through your Status column
    Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
        Case "Ready for testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
            NewRange.Formula = Range(cell.Offset(0, -2), cell.Offset(0, -2)).Formula 'Copies the formula from Column A
            NewRange.Offset(0, 1).Value = Range(cell.Offset(0, -1), cell.Offset(0, -1)).Value ' Copies the value from Column B
            NewRange.Offset(0, 2).Value = Range(cell).Formula ' Copies the formula from Column C
            Set NewRange = NewRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
    End Select
Next cell

End Sub