Cut and Paste value from Column B to next empty row Column A

Question

I would like to cut a value from Column B (444) to next empty row in Column A (under rr). The script would then loop through Column B so 16 would be pasted under ee etc

I played around with the following code to find the next blank row in Column A but need some more help to construct the script;

lastrow = Sheets(1).Range("A1").End(xlDown).Row + 1

Any help would be appreciated

Marco Vos Marco Vos · Accepted Answer · 2018-07-15T10:10:56

What you need is something like this:

Sub CutValuesColumnBtoA()

Dim copyCell As Range
Dim colB As Range
Dim lastRowColB As Long
Dim firstBlankRowColA As Long

'get the rownumber of the last non-empty cell in column B
lastRowColB = Cells(Rows.Count, 2).End(xlUp).Row

'get the range thats holds the values to be cut&pasted from column B
Set colB = Range(Cells(1, 2), Cells(lastRowColB, 2))

'loop through the values in colB.
'If not empty then paste to first empty cell in column A
For Each copyCell In colB

    If copyCell <> "" Then

        'get the rownumber of the first blank cell in column A
        'Cells(1, 1).End(xlDown).Row will not work if one or both of the 
        'first two rows are empty, so they need to be tested separatly
        If Cells(1, 1) = "" Then
            firstBlankRowColA = 1
        ElseIf Cells(2, 1) = "" Then
            firstBlankRowColA = 2
        Else
            firstBlankRowColA = Cells(1, 1).End(xlDown).Row + 1
        End If

    Cells(firstBlankRowColA, 1).Value = copyCell

    End If

Next copyCell

'clear colB Range, because this is a cut action (and not copy)
colB.ClearContents

End Sub

Cut and Paste value from Column B to next empty row Column A

1 Answers