Excel VBA moveing x amount rows down

Question

I'm working with some Excel at the moment where I'm creating some macros to make my life easier. I'm looking for a little bit of code that can move all data from column B underneath column A. The problem with the code is the amount of data in the columns is always different. The paste location will therefore always be different. I'm just looking for the code to move it x amount down and one column to the left.

Screenshot:

Answer 1

Sub moveData()

Dim rowAcount As Long
Dim rowBcount As Long

Dim currSheet As Worksheet
Set currSheet = ActiveSheet

currSheet.Range("A1").End(xlDown).Select
rowAcount = ActiveCell.Row
rowAcount = rowAcount + 1

currSheet.Range("B1").End(xlDown).Select
rowBcount = ActiveCell.Row

currSheet.Range("B1:B" & rowBcount).Copy _
    Destination:=currSheet.Range("A" & rowAcount & ":A" & (rowAcount + rowBcount))

Columns(2).Delete

End Sub

WARNING: If you have any blanks in your data, you must use something like the following to select your data sets:

rowAcount = currSheet.Range("A1").CurrentRegion.Rows.Count
rowBcount = currSheet.Range("B1").CurrentRegion.Rows.Count

But this copies the total number of rows in the sheet, and if row B has more data than row A, you will get blanks. Thus I opted for the above answer first.

edit fixed typo