Copy value to next empty cell

Question

I want to find empty cells and copy there values:

Values: "10/11/2017" and "Yes" should be copied to row 7 (colB & colC).

What I have:

Sub add_value()

Dim wbA As Workbook
Dim wsA As Worksheet

Set wbA = ActiveWorkbook
Set wsA = wbA.Worksheets("Sheet1")

Dim nrow As Long

nrow = 6

    Do Until wsA.Range("B" & nrow).Value = ""
        wsA.Range("B" & nrow).Value = wsA.Range("B3").Value
        wsA.Range("C" & nrow).Value = wsA.Range("C3").Value
            Exit Sub
        nrow = nrow + 1
    Loop

End Sub

Something is wrong with my loop and I don't know how to fix it.

Answer 1

No need to loop through your rows until you find an empty one. You can replace the entire sub with this:

Sub add_value()
    With ThisWorkbook.Worksheets("Sheet1")
        .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(1, 2).Value = .Range("B3:C3").Value
    End With
End Sub

---

As per your comments, to also add borders you can reorganise the code a bit like this:

Sub add_value()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With ws.Cells(ws.Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(1, 2)
        .Value = ws.Range("B3:C3").Value
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
    End With
End Sub

Answer 2

I would have done something like this:

Sub FindFirstEmptyValue()

    Dim lastRow     As Long

    With Worksheets("Sheet1")
        lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
        .Cells(lastRow, 2) = .Range("B3").value
        .Cells(lastRow, 3) = .Range("C3").value
    End With

End Sub

It gives you the last row, you increment it with 1 and on this row you write the B3 and C3 values.