Help creating macro to cut the last cell in a range with data to the top of the range

[Sinaloense]

Hi all,

I'm looking to create a macro look through a column and cut the last cell containing data and paste to the beginning of the data (top). I know I can do this manually dragging and dropping while holding Shift. I'm fairly new to excel and I would appreciate the help.

Thank you!

 

[Sinaloense]

Thanks for the clarification. I have still made 2 assumptions:

1. There is no heading like in your image and it is just the lists that appear in the column as per my first mini sheet below, and
2. The values in the column are not the result of formulas.

Sub BottomToTop_v2()
  Dim rA As Range
 
  Const Col As String = "B" '<- Set your column of interest here
 
  For Each rA In Columns(Col).SpecialCells(xlConstants).Areas
    rA.Cells(rA.Count).Cut
    rA.Cells(1).Insert
  Next rA
End Sub

Before

Sinaloense.xlsm
	B
1
2
3	1
4	2
5	3
6	4
7
8
9
10	A
11	B
12	C
13	D
14	E
15	F
16
17	cat
18	dog
19
Sheet1 (2)

After run 1

Sinaloense.xlsm
	B
1
2
3	4
4	1
5	2
6	3
7
8
9
10	F
11	A
12	B
13	C
14	D
15	E
16
17	dog
18	cat
19
Sheet1 (2)

After run 2

Sinaloense.xlsm
	B
1
2
3	3
4	4
5	1
6	2
7
8
9
10	E
11	F
12	A
13	B
14	C
15	D
16
17	cat
18	dog
19
Sheet1 (2)

This worked!!
Can I modify the code for it to work on multiple columns and behave the same?

 

[Peter_SSs]

Can I modify the code for it to work on multiple columns and behave the same?

Sure. I have assumed that each column of interest will have at least one block of data to act on.

Sub BottomToTop_v3()
  Dim rA As Range
  Dim Col As Variant
  
  Const myCols As String = "B E F J" '<- Set your columns of interest here
  
  Application.ScreenUpdating = False
  For Each Col In Split(myCols)
    For Each rA In Columns(Col).SpecialCells(xlConstants).Areas
      rA.Cells(rA.Count).Cut
      rA.Cells(1).Insert
    Next rA
  Next Col
  Application.ScreenUpdating = True
End Sub

 

[Sinaloense]

Sure. I have assumed that each column of interest will have at least one block of data to act on.

Sub BottomToTop_v3()
  Dim rA As Range
  Dim Col As Variant
 
  Const myCols As String = "B E F J" '<- Set your columns of interest here
 
  Application.ScreenUpdating = False
  For Each Col In Split(myCols)
    For Each rA In Columns(Col).SpecialCells(xlConstants).Areas
      rA.Cells(rA.Count).Cut
      rA.Cells(1).Insert
    Next rA
  Next Col
  Application.ScreenUpdating = True
End Sub

Thanks man
You’re the best!!

 

[Peter_SSs]

Cheers. Glad to help. Thanks for the follow-up.

 

[Sinaloense]

Cheers. Glad to help. Thanks for the follow-up.

One last thing, how would I reverse the movement. (Top to bottom)?
Thanks again!

 

[Peter_SSs]

One last thing, how would I reverse the movement. (Top to bottom)?

Try this

Sub TopToBottom_v1()
  Dim rA As Range
  Dim Col As Variant
  
  Const myCols As String = "B E F J" '<- Set your columns of interest here
  
  Application.ScreenUpdating = False
  For Each Col In Split(myCols)
    For Each rA In Columns(Col).SpecialCells(xlConstants).Areas
      rA.Cells(1).Cut
      rA.Cells(rA.Count + 1).Insert
    Next rA
  Next Col
  Application.ScreenUpdating = True
End Sub

 

[Sinaloense]

Try this

Sub TopToBottom_v1()
  Dim rA As Range
  Dim Col As Variant
 
  Const myCols As String = "B E F J" '<- Set your columns of interest here
 
  Application.ScreenUpdating = False
  For Each Col In Split(myCols)
    For Each rA In Columns(Col).SpecialCells(xlConstants).Areas
      rA.Cells(1).Cut
      rA.Cells(rA.Count + 1).Insert
    Next rA
  Next Col
  Application.ScreenUpdating = True
End Sub

Once again, Thank you so much!

 

[Peter_SSs]

No problem.