Excel Macro - copy cells from one sheet into another based on value

Question

I would like to copy cells from one Sheet into another based on Values in one Column. The problem is I want to copy the values and not the formulas, but I can't get the Destination command to work with Pastespecial. So far I have:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)

Dim i, LastRow

LastRow = Range("A" & Rows.Count).End(xlUp).Row

Sheets("Available").Cells.ClearContents

For Each c In Range("A1:A" & LastRow)

If UCase(c.Offset(0, 1).Value) = "Not Sold" Then

Range("A" & c.Row & ":" & "G" & c.Row).Copy _

Destination:=Sheets("Available").Range("A" & Rows.Count) _

.End(xlUp).Offset(1)

End If

Next c

Target.Offset(1).Select
End Sub

I also want to copy some cells above the cell with the value and add it to the right side of the row copied to the new sheet.

Any help would be really appreciated.

The problem lies here UCase(c.Offset(0, 1).Value) = "Not Sold". UCase implies that the word would be in all upper case. Change "Not Sold" to "NOT SOLD" or remove the UCase wrapper. — Scott Holtzman

Malil Malil · Accepted Answer · 2016-06-13T21:56:32

First let me point out a couple things I don't think are working, or a good idea.

Using If UCase(c.Offset(0, 1).Value) = "Not Sold" should fail every time, since you're converting to uppercase and then comparing it. You want If Ucase(c.Offset(0, 1).Value) = "NOT SOLD"

Second, you're setting up i and LastRow as Variants, instead of Integers, which I believe is what you want. Technically not a problem but I don't like unknown variables. You also don't seem to be using i, unless I'm overlooking something.

Finally, to find the last row accurately, I would use

lastRow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).row

This is the most reliable method of finding the last row that I know of, and actually found right here on stack.

Now, for the actual code itself, here is my recommendation.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _ Cancel As Boolean)

    Dim i, LastRow as Integer
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = ActiveSheet
    Set ws2 = Sheets("Available")

    i = 1

    LastRow = ws1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    ws2.Cells.ClearContents

    For Each c In Range(Cells(1,2), Cells(LastRow, 2))
        If UCase(c.Value) = "NOT SOLD" Then
            ws2.Range(ws2.Cells(i, 1), ws2.Cells(i, 7)).Value = ws1.Range( _
                ws1.Cells(c.Row, 1), ws1.Cells(c.Row, 7)).Value
            i = i + 1
        End If
    Next c

    Target.Offset(1).Select 

End Sub

Excel Macro - copy cells from one sheet into another based on value

1 Answers