insert rows after data change in column

[mayer]

I have a wooksheet with numbers in column a and after the last same number i
want to insert 6 rows
1
1
1
2
2
3
3
3
4
4
5
5
5
6
6
7
7
8
8
9
9
10
10
11
11
12
12

any help
mayer

 

[Chip Pearson]

Try something like

Sub AAA()
Dim SaveVal As Long
Dim R As Range
Dim StartRow As Long

StartRow = 1
Set R = Cells(StartRow, "A")
SaveVal = R.Value
Do Until R.Value = vbNullString
If R.Value <> SaveVal Then
SaveVal = R.Value
R.Resize(6, 1).EntireRow.Insert
End If
Set R = R(2, 1)
Loop
End Sub

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[Don Guillett]

If I understand your request properly, this should do it.

Sub insert6rowsaftersamelastnumber()
Dim i As Long
Dim mc As Long

mc = 1 ' col a
For i = Cells(Rows.Count, mc).End(xlUp).Row To 2 Step -1
If Cells(i - 1, mc) = Cells(i, mc) Then
Rows(i + 1).Resize(6).Insert
Exit For
End If
Next i
End Sub