Macro Loop

[gripper]

I have a spread sheet that I have a macro on. What it basically does it takes data in Column A and repositions the data into 5 columns (Columns C - G) Basically it should act typing a letter where when it gets to Column G it now goes to the next row Column C then across and so on.

So for insance Cell "7A" will go to Cell "2C" and so on until the list in Column A is at the bottom.

I have some macro code:
_________________________________________
Range("A6").Select
Application.CutCopyMode = False
Selection.Copy
Range("C2").Select
ActiveSheet.Paste
Range("A7").Select
Application.CutCopyMode = False
Selection.Copy
Range("D2").Select
ActiveSheet.Paste
Range("A8").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Range("E2").Select
ActiveSheet.Paste
Range("A9").Select
Application.CutCopyMode = False
Selection.Copy
Range("F2").Select
ActiveSheet.Paste
Range("A10").Select
Application.CutCopyMode = False
Selection.Copy
Range("G2").Select
ActiveSheet.Paste
______________________________________

Now what I want to do is loop this instead of me recording a macro for 5000 cells.

I have found great help in the past and I am hoping somebody could offer a hand now. It would be greatly appreciated.

Essentially if I have 5000 pieces of data then it will be evenly split in to 5 columns 1000 each.

Another solutions would be to determine how many records I have below a certain row(lets say 5000) and then copy the first 1000 cells to Column C then the Second to Column D Just a thought.

Thank you

 

[diddi]

try this

Sub rearrange()
    For Row = 6 To 5000 Step 5
        For col = 3 To 7
            Cells(Int(Row / 5) + 1, col) = Cells(Row + col - 3, 1)
        Next col
    Next Row
End Sub

 

[tweedle]

That is sick...in a good way!

 

[diddi]

I think.... um.....

that's a compliment


Smashed it!

 

[MrKowz]

To expand on what diddi provided to make is run faster:

Sub rearrange()
Application.ScreenUpdating = False
         For Row = 6 To 5000 Step 5
                 For col = 3 To 7
                         Cells(Int(Row / 5) + 1, col) = Cells(Row + col - 3, 1)
                 Next col
         Next Row
Application.ScreenUpdating = True
End Sub

 

[diddi]

and it probvably wouldnt hurt to do

application.calculation=xlManual
... = xlAutomatic

just for good measure

 

[gripper]

Diddi that worked perfectly thank you very much.

Perhaps I have another question in this particular work sheet I have two columns.

Column A is the original list that your code helped sort out fantastically but perhaps I can extend this a little bit.

Like I said there is 2 columns when I sort by Column B it will move to the top the blank cells. These cells end up being my column headers. Then the rearrage code will move the rest of the items into the columns.

What I want to do is "If" I have a different number (like range from 5-10 max) then now I have that particular number of column headers. Now with your rearrange code I would like to access how many column headers then starting at the row move them into the columns.

So lets say I have 5000 items in column A and when I sort column B will have 7 bank cells. So now I know the items in the first 7 rows of Column A will transpose to my column headers starting at Row C movining right. Now since I made these first 7 words column A into column headers now I want to start at cell A8 and then rearrage using your code.

I hope this makes since. So I am thinking some type of if statement or something. I just cannot figure it out because the columns will have up to 10 max.

Thanks

 

[diddi]

try this... (untested)

Sub rearrange()
    Dim NumCols as Long, Row as Long, Col as Long

    NumCols=5   '  change this as needed

    For Row = 6 To 5000 Step NumCols
        For col = 3 To NumCols + 2
            Cells(Int(Row / NumCols) + 1, col) = Cells(Row + col - 3, 1)
        Next col
    Next Row
End Sub