Simple (?) Macro Assistance- Select, Insert, Paste, Rinse, Repeat

P

Pete_CSC

Hi, hoping someone can help. I need to write a macro that will Selec
cells 6-10 from a row of 20 and insert them below the original line
select cells 11-15 insert below 6-10, select cells 16-20 and inser
below 11-15. Then move down to a new row of data and repeat th
process. It seem so simple, but I am a complete novice
 
A

Anson

Try record the process you have just describe. Do some prunings and put a loop (For... Next or Do While.... loop) over it. This set of codes would be too tedious to write by hand.
 
T

Tom Ogilvy

Either of these seems to work:

Sub ReorderData()
Dim rng As Range, rng1 As Range
Dim rng2 As Range, rng3 As Range
Set rng = Cells(ActiveCell.Row, 1)
Set rng1 = Cells(ActiveCell.Row, 6).Resize(1, 5)
Set rng2 = rng1.Offset(0, 5)
Set rng3 = rng1.Offset(0, 10)
rng.Offset(1, 0).Resize(3).EntireRow.Insert
rng.Offset(1, 0).Resize(1, 5).Value = rng1.Value
rng.Offset(2, 0).Resize(1, 5).Value = rng2.Value
rng.Offset(3, 0).Resize(1, 5).Value = rng3.Value
End Sub

Sub ReorderData1()
Dim rng As Range, rng1 As Range
Dim rng2 As Range, rng3 As Range
Set rng = Cells(ActiveCell.Row, 1)
rng.Offset(1, 0).Resize(3).EntireRow.Insert
For i = 1 To 3
rng.Offset(i, 0).Resize(1, 5).Value = _
rng.Offset(0, i * 5).Resize(1, 5).Value
Next
End Sub

I am not sure of your starting and stopping conditions, but you could put a
loop around either and have

Sub ReorderData1()
Dim rng As Range, rng1 As Range
Dim rng2 As Range, rng3 As Range
Dim i As Long, j As Long
For j = 1 To 4
Set rng = Cells(ActiveCell.Row, 1)
rng.Offset(1, 0).Resize(3).EntireRow.Insert
For i = 1 To 3
rng.Offset(i, 0).Resize(1, 5).Value = _
rng.Offset(0, i * 5).Resize(1, 5).Value
Next i
ActiveCell.Offset(4, 0).Select
Next j
End Sub

as an example to do 4 existing rows.
 
P

Pete_CSC

Hi Tom, thank you very much for your Macro; it is very close to what
need. How do I tell it to start at row 16 and repeat 200 times instea
of 4
 
T

Tom Ogilvy

Sub AAReorderData1()
Dim rng As Range, rng1 As Range
Dim rng2 As Range, rng3 As Range
Dim i As Long, j As Long
For j = 16 To 816 Step 4
Set rng = Cells(j, 1)
rng.Offset(1, 0).Resize(3).EntireRow.Insert
For i = 1 To 3
rng.Offset(i, 0).Resize(1, 5).Value = _
rng.Offset(0, i * 5).Resize(1, 5).Value
Next i
Next j
End Sub
 
Top