how to spread data evenly in multiple rows

[zgsharon]

I found this code online and was wondering if someone could tell me how to make this work for more than one column at once? The code inserts a specific number of blank spaces into a column of data. I just need to do it for 3 or 4 columns at once and am having some problems altering the code. Any help would be greatly appreciated.

Sub MG28Sep05()
Dim Last As Integer, n
' Change "A" Below To another column Letter
Last = Range("A" & Rows.Count).End(xlUp).row

For n = Last To 2 Step -1
' Change "7" Below To No of Blank Rows Required
Cells(n, 1).Resize(7).Insert shift:=xlDown
Next n
End Sub

 

[DKaur]

Change Resize(7) to Resize(7,3) or Resize(7,4) depending on how many columns you need it for. Should work.

 

[zgsharon]

Thank you DKaur. That worked like a charm. Do you know if there is a way to get the data to spread a random value of rows over a given range? So in some cases there might be 4 blank rows in between numbers and in another case there would only be 2 or 3. If I start with the data below and run the code, I'd want it to look like the second example where the start and end values of columns A, B and C match those of D, E and F with a random value of blank rows placed in between.

A	B	C		D	E	F
6	6	6		5	5	4
45	45	45		64	45	23
4	4	4		43	4	23
5	5	5		234	23	4
				64	46	5
				234	64	5
				24	2	43
				3	34	34
				5	4	23
				6	56	1
				4	23	32

<tbody>
</tbody>

After running code- I just need the first and last rows of columns A, B and C to line up with D, E, and F, with random blanks placed in between. So there are 3 blank spaces and then only two after the row of 4's.

A	B	C		D	E	F
6	6	6		5	5	4
				64	45	23
				43	4	23
				234	23	4
45	45	45		64	46	5
				234	64	5
				24	2	43
				3	34	34
4	4	4		5	4	23
				6	56	1
				4	23	32
5	5	5		23	4	12

<tbody>
</tbody>

 

[DKaur]

How about this:

Sub MG28Sep05()
Dim Last, EndRow, n, y As Integer
' Change "A" Below To another column Letter
Last = Range("A" & Rows.Count).End(xlUp).Row
EndRow = Range("D" & Rows.Count).End(xlUp).Row


For n = Last To 2 Step -1
If n = Last Then
Cells(n, 1).Resize(EndRow - Last, 3).Insert shift:=xlDown
Else
Cells(n, 1).Resize(1, 3).Cut
y = n * ((EndRow) / (Last))
Cells(y, 1).Select
ActiveSheet.Paste
End If
Next n


End Sub