Trying to move data from every 3rd row to up 1

Mo0nlight · Jan 8, 2018

Hello all,

I'm trying to create a VBA macro to move the yellow highlight cells to the green cell just like how you see it in the picture below.

The amount of rows of information can be from 40 line to 900 so I would need something that would continue moving cells over until there isn't any more information in Columns A-I.

The ideal result show reflect like this for as many rows as needed.

I'm still pretty new the VBA world and have created some for other proposes but I just can't seem tot figure this one out.

Joe4 · Jan 8, 2018

Welcome to the Board!

Your image attempts are not working. There are tools you can use to post screen images. They are listed in Section B of this link here: http://www.mrexcel.com/forum/board-a...forum-use.html.
Also, there is a Test Here forum on this board that you can use to test out these tools to make sure they are working correctly before using them in your question.

Mo0nlight · Jan 9, 2018

first image should have been this:

https://i.stack.imgur.com/Qi4ux.png

the second image is this:

https://i.stack.imgur.com/jKMO3.png

Mo0nlight · Jan 9, 2018

thanks. I posted links below for each image

Joe4 · Jan 9, 2018

I am unable to access those sites or down load files from the internet from my current location (my workplace security blocks all of that for security reasons). Many other users have the same security concerns.
That is why I recommend using those tools mentioned, if possible.

Perhaps someone who can will take a look at those images. If not, I will see if I can get find some time tonight when I am at home.

Rick Rothstein · Jan 9, 2018

Give this macro a try...

Code:

Sub MoveData()
  Dim R As Long
  For R = 2 To Cells(Rows.Count, "A").End(xlUp).Row Step 3
    Cells(R, "A").Resize(, 3).Cut Cells(R - 1, "J")
    Cells(R, "F").Resize(, 4).Cut Cells(R - 1, "O")
  Next
End Sub

Mo0nlight · Jan 22, 2018

I actually resolved this with those code. I have i as 4 because there are often times that the first 5 rows do not need to be moved.

Sub CopyCells1()

Dim i As Long, lastRow As Long, rngToMove As Range

lastRow = Worksheets("cxl macro test").Cells(1048576, 1).End(xlUp).Row

For i = 4 To lastRow

If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then

Worksheets("cxl macro test").Cells(i - 2, 10) = Worksheets("cxl macro test").Cells(i - 1, 1)

Worksheets("cxl macro test").Cells(i - 1, 1) = ""