Copy row from another workbook when it has an exact value

Question

I have kind of a basic question. I want to copy rows from workbook "WB1" to workbook "WB" if a cell (i,4) has an exact known value. The code I have tried to write is not working, what can I do do make it work? Hope someone can help me :)

Private Sub CommandButton1_Click()

Dim i As Integer

For i = 8 To 300

If Workbooks("WB1").Worksheets("Commodity Action Plan").Cell(i,4).Value  = "Zamet" Then Workbooks("WB1").Worksheets("Commodity Action Plan").EntireRow.Copy

Workbooks("WB2").Worksheets("Action plan").EntireRow.Paste

End If

Next i

End Sub

Answer 1

I copied and checked your code and it wouldn't compile due to a few errors..

Your If statement was on one line, when it should be

If ValueToEvaluate = true Then

'code to execute goes here

End If 

or

If ValueToEvaluate = True Then 'code to execute goes here

If you have the full statement on one line then you don't need the End If .

2nd problem is that you are trying to get the entirerow property of a sheet,

Workbooks("WB1").Worksheets("Commodity Action Plan").EntireRow.Copy

this exists on a range object, so you probably wanted something like

Workbooks("WB1").Worksheets("Commodity Action Plan").Rows(i).EntireRow.Copy

Rather than using Paste you can specify a destination (range) as the second argument for the Copy function, which is easier and less prone to errors than the copy & paste 2 stage method.

---

Try something like:

Private Sub CommandButton1_Click()

Dim i As Long   'Change to long so we don't get an error past row 32767
Dim outRow as Long    
Dim sourceWs As Worksheet, destWs As Worksheet

Set sourceWs = Workbooks("WB1").Worksheets("Commodity Action Plan")
Set destWs = Workbooks("WB2").Worksheets("Action plan")

outRow = 1

'For testing
'Set sourceWs = Sheet1
'Set destWs = Sheet2

    For i = 8 To 300

        If sourceWs.Cells(i, 4).Value = "Zamet" Then

        sourceWs.Rows(i).EntireRow.Copy destWs.Rows(outRow)
        outRow = outRow + 1
        Application.CutCopyMode = False

        End If

    Next i

End Sub