Cut the last entry and paste in another column

[bamboo1975]

Hi ,

I got a column of 1000 numbers (fromD1 to D1000) and need a piece of code to do the below,

while in A1, finds the very bottom non-empty cell in D (D1000), CUT the content and paste it in A1.
then go down for 27 cells (to A27), again find the last non-empty cell of col D (which obviously will be D999) cut it and paste it in A27,
and keep going down for 27 cells and do the same for 500 times.

Cheers for the help.

 

[NoSparks]

see if this will do it for you

Sub MoveStuff()
    
Dim i As Long, Lrow As Long, rng As Range

Lrow = 1000
With Sheets("Sheet1") '<~~~ change to your actual sheet name
    Set rng = .Cells(1, 1)
    For i = 1 To 500
        rng.Value = .Cells(Lrow, 4).Value
        .Cells(Lrow, 4).ClearContents
        Lrow = Lrow - 1
        Set rng = rng.Offset(26)
    Next i
End With

End Sub

 

[bamboo1975]

Hi and thanks for the reply. It doesnt work actually. Probably I hadnt been clear enough. It needs to CUT the value of last cell of column D and Paste in A1 and do that for 500 loops but every time paste it in 27 cells below the cell it pasted it on previous loop. i,e first loop paste in A1, second loop in A27, third loop in A54 and so on.

Cheers

 

[NoSparks]

It doesnt work actually.

That's not very descriptive.

It needs to CUT the value

What do you mean by CUT the value? Wasn't the value put into the A column and removed from the bottom of the D column?

It needs to CUT the value of last cell of column D and Paste in A1 and do that for 500 loops but every time paste it in 27 cells below the cell it pasted it on previous loop. i,e first loop paste in A1, second loop in A27, third loop in A54 and so on.

Can you define 'and so on' ?
because A27 is 26 cells below A1,
and A54 is 27 cells below A27,
what would be the next cell to use below A54, or are those cells maybe not correct?

 

[bamboo1975]

That's not very descriptive.

What do you mean by CUT the value? Wasn't the value put into the A column and removed from the bottom of the D column?

Can you define 'and so on' ?
because A27 is 26 cells below A1,
and A54 is 27 cells below A27,
what would be the next cell to use below A54, or are those cells maybe not correct?

OK let me simplify it and I'll tweak the code to my need later. Have a look at attached image please. I want the numbers in col D distributed in column A into corresponding color cells

 

[NoSparks]

Sub TryThis()

Dim i As Long, Lrow As Long, rng As Range

With Sheets("Sheet2")   '<~~~ change to suit
    Lrow = .Range("D" & .Rows.Count).End(xlUp).Row
    Set rng = .Cells(1, 1)
    For i = 1 To Lrow
        If i = 1 Then
            rng = .Cells(Lrow, 4).Value
            .Cells(Lrow, 4).Delete xlShiftUp
            'first loop offset
            Set rng = rng.Offset(4)
            Lrow = Lrow - 1
        Else
             rng = .Cells(Lrow, 4).Value
            .Cells(Lrow, 4).Delete xlShiftUp
            'rest of loops offset
            Set rng = rng.Offset(5)
            Lrow = Lrow - 1
        End If
    Next i
End With
End Sub

 

[bamboo1975]

Sub TryThis()

Dim i As Long, Lrow As Long, rng As Range

With Sheets("Sheet2")   '<~~~ change to suit
    Lrow = .Range("D" & .Rows.Count).End(xlUp).Row
    Set rng = .Cells(1, 1)
    For i = 1 To Lrow
        If i = 1 Then
            rng = .Cells(Lrow, 4).Value
            .Cells(Lrow, 4).Delete xlShiftUp
            'first loop offset
            Set rng = rng.Offset(4)
            Lrow = Lrow - 1
        Else
             rng = .Cells(Lrow, 4).Value
            .Cells(Lrow, 4).Delete xlShiftUp
            'rest of loops offset
            Set rng = rng.Offset(5)
            Lrow = Lrow - 1
        End If
    Next i
End With
End Sub

Worked like a charm for me. Cheers mate.