Create loop to insert two rows after every row of data

  • Thread starter Thread starter robs_drunk
  • Start date Start date
R

robs_drunk

Hi
My Data starts at A8:C500 i have a count to find exact number of
lines.

myCount = Selection.Rows.Count

this works fine.

Now i need to the insert 2 blank lines under the first line and then
merge and center Column A and then do the same for B and C, i can do
this once but i require to repeat this for the amount of the myCount.
Below is a sort psuedo code for it that is foresee.



Count Rows
at begining insert 2 lines
Center and merge colums A,B and C for the three lines(1 data and 2
blank)
Repeat for line two of Data(which is now at A4 instead of A2 since the
insert)
until Count of rows = 0
Please help!!!!!!
 
My Data starts at A8:C500 i have a count to find exact number of
lines.

myCount = Selection.Rows.Count

this works fine.

Now i need to the insert 2 blank lines under the first line and then
merge and center Column A and then do the same for B and C, i can do
this once but i require to repeat this for the amount of the myCount.
Click to expand...

Maybe this will help with part of your requirement. This inserts
lines after each row of the data:

Dim i, rgTop, rgBot As Long

rgTop = 4: rgBot = 20 ' plug in your own stuff here, e.g., "myCount"

For i = rgBot To rgTop + 1 Step -1
Rows(i).Insert Shift:=xlDown
Next

It runs, but it's a bit slow. Maybe someone will tell us how to
make it faster.

=dman=

====================================
 
Try following macro:

Sub InsertLinesAndMergeCells()
Cells(1, 1).Select
k = 1
For i = 1 To 65536
Selection.Offset(1, 0).Select
Selection.EntireRow.Insert
Selection.EntireRow.Insert
For j = 1 To 3
Range(Cells(k, j), Cells(k + 2, j)).Select
Selection.Merge
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
Next j
k = k + 3
Cells(k, 1).Select
If IsEmpty(Cells(k, 1)) = True Then Exit Sub
Next i
End Sub


Regards
reklamo
 
Try following macro:

Sub InsertLinesAndMergeCells()
Cells(1, 1).Select
k = 1
For i = 1 To 65536
Selection.Offset(1, 0).Select
Selection.EntireRow.Insert
Selection.EntireRow.Insert
For j = 1 To 3
Range(Cells(k, j), Cells(k + 2, j)).Select
Selection.Merge
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
Next j
k = k + 3
Cells(k, 1).Select
If IsEmpty(Cells(k, 1)) = True Then Exit Sub
Next i
End Sub

Regards
reklamo









- Show quoted text -
Click to expand...

Sorry this does not work can any one HELP me please
 
Back
Top