Sub InsertRows()
With Range("C1:C" & Range("B" & Rows.Count).End(xlUp).Row)
.Value = Evaluate("row(1:" & .Rows.Count & ")")
.Replace What:="*?1", Replacement:=True, LookAt:=xlWhole
.SpecialCells(xlConstants, xlLogical).EntireRow.Insert
.ClearContents
End With
End Sub
=IF(MOD(ROW(),11)=0,"",IF(ROW()=1,1,MAX($B$1:B1)+1))
Strangely, I have to copy my existing data to two columns to make the code worksTry this with a copy of your data. I have assumed column C is empty. If not, choose another column.
VBA Code:Sub InsertRows() With Range("C1:C" & Range("B" & Rows.Count).End(xlUp).Row) .Value = Evaluate("row(1:" & .Rows.Count & ")") .Replace What:="*?1", Replacement:=True, LookAt:=xlWhole .SpecialCells(xlConstants, xlLogical).EntireRow.Insert .ClearContents End With End Sub
This is great, but I got different dataB1=1
B2=
drag downCode:=IF(MOD(ROW(),11)=0,"",IF(ROW()=1,1,MAX($B$1:B1)+1))
Works for me with a single column of data.Strangely, I have to copy my existing data to two columns to make the code works
22 06 07.xlsm | |||||
---|---|---|---|---|---|
A | B | C | |||
1 | Data 1 | ||||
2 | Data 2 | ||||
3 | Data 3 | ||||
4 | Data 4 | ||||
5 | Data 5 | ||||
6 | Data 6 | ||||
7 | Data 7 | ||||
8 | Data 8 | ||||
9 | Data 9 | ||||
10 | Data 10 | ||||
11 | Data 11 | ||||
12 | Data 12 | ||||
13 | Data 13 | ||||
14 | Data 14 | ||||
15 | Data 15 | ||||
16 | Data 16 | ||||
17 | Data 17 | ||||
18 | Data 18 | ||||
19 | Data 19 | ||||
20 | Data 20 | ||||
21 | Data 21 | ||||
22 | Data 22 | ||||
23 | Data 23 | ||||
24 | Data 24 | ||||
25 | Data 25 | ||||
26 | Data 26 | ||||
27 | Data 27 | ||||
28 | Data 28 | ||||
29 | Data 29 | ||||
30 | Data 30 | ||||
31 | Data 31 | ||||
32 | Data 32 | ||||
Insert Rows |
22 06 07.xlsm | |||
---|---|---|---|
B | |||
1 | Data 1 | ||
2 | Data 2 | ||
3 | Data 3 | ||
4 | Data 4 | ||
5 | Data 5 | ||
6 | Data 6 | ||
7 | Data 7 | ||
8 | Data 8 | ||
9 | Data 9 | ||
10 | Data 10 | ||
11 | |||
12 | Data 11 | ||
13 | Data 12 | ||
14 | Data 13 | ||
15 | Data 14 | ||
16 | Data 15 | ||
17 | Data 16 | ||
18 | Data 17 | ||
19 | Data 18 | ||
20 | Data 19 | ||
21 | Data 20 | ||
22 | |||
23 | Data 21 | ||
24 | Data 22 | ||
25 | Data 23 | ||
26 | Data 24 | ||
27 | Data 25 | ||
28 | Data 26 | ||
29 | Data 27 | ||
30 | Data 28 | ||
31 | Data 29 | ||
32 | Data 30 | ||
33 | |||
34 | Data 31 | ||
35 | Data 32 | ||
36 | |||
Insert Rows |
.. or perhaps I have not understood the requirement?
Sub Add_row_after_10()
Dim rwArr, i As Long, ii As Long, j As Long, rng As Range
ReDim rwArr(1 To Application.WorksheetFunction.RoundUp(Cells(Rows.Count, 1).End(xlUp).Row / 10, 0))
Application.ScreenUpdating = False
i = 1
For j = LBound(rwArr) To UBound(rwArr)
i = i + 10
rwArr(j) = i
Next j
For ii = LBound(rwArr) To UBound(rwArr)
If rng Is Nothing Then
Set rng = Rows(rwArr(ii))
Else
Set rng = Union(rng, Rows(rwArr(ii)))
End If
Next ii
Intersect(rng.Rows, Columns(1)).EntireRow.Insert
Application.ScreenUpdating = True
End Sub
That code requires data in column A. In post #1 you showed data in column B only.Other persons assist me on this,
Sub InsertRows()
With Range("C1:C" & Range("A" & Rows.Count).End(xlUp).Row)
.Value = Evaluate("row(1:" & .Rows.Count & ")")
.Replace What:="*?1", Replacement:=True, LookAt:=xlWhole
.SpecialCells(xlConstants, xlLogical).EntireRow.Insert
.ClearContents
End With
End Sub
Sub InsertRows_v2()
With Cells(1, ActiveSheet.UsedRange.Columns.Count + 1).Resize(Range("A" & Rows.Count).End(xlUp).Row)
.Value = Evaluate("row(1:" & .Rows.Count & ")")
.Replace What:="*?1", Replacement:=True, LookAt:=xlWhole
.SpecialCells(xlConstants, xlLogical).EntireRow.Insert
.ClearContents
End With
End Sub
For future reference, this is known as Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.Other persons assist me on this, thanks for your time.