Note: The other languages of the website are Google-translated. Back to English
English English

How to insert specific number of rows at fixed intervals in Excel?

In Excel worksheet, you can insert a blank row between existing rows by using Insert function. But, if you have a large range of data, and, you need to insert two blank rows after every third ot nth row, how could you finish this job quickly and conveniently?


Insert specific number of blank rows into data range at fixed intervals with VBA code

The following VBA code can help you to insert a specific number of rows after every nth row within existing data. Please do as follows:

1. Hold down the ALT + F11 keys in Excel, and it opens the Microsoft Visual Basic for Applications window.

2. Click Insert > Module, and paste the following code in the Module Window.

VBA code: Insert specific number of rows into data at fixed intervals

Sub InsertRowsAtIntervals()
'Updateby Extendoffice
Dim Rng As Range
Dim xInterval As Integer
Dim xRows As Integer
Dim xRowsCount As Integer
Dim xNum1 As Integer
Dim xNum2 As Integer
Dim WorkRng As Range
Dim xWs As Worksheet
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xRowsCount = WorkRng.Rows.Count
xInterval = Application.InputBox("Enter row interval. ", xTitleId, 1, Type:=1)
xRows = Application.InputBox("How many rows to insert at each interval? ", xTitleId, 1, Type:=1)
xNum1 = WorkRng.Row + xInterval
xNum2 = xRows + xInterval
Set xWs = WorkRng.Parent
For i = 1 To Int(xRowsCount / xInterval)
    xWs.Range(xWs.Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).Select
    Application.Selection.EntireRow.Insert
    xNum1 = xNum1 + xNum2
Next
End Sub

3. After pasting this code, please press F5 key to run this code, a prompt box will pop out to remind you selecting the data range that you want to insert blank rows, see screenshot:

4. Click OK button, another prompt box will pop out, please enter the number of row intervals, see screenshot:

5. Go on clicking OK button, in the following popped out prompt box, please enter the number of blank rows that you want to insert, see screenshot:

6. Then click OK, and the blank rows have been inserted into the existing data at a regular intervals, see screenshots:


Insert specific number of blank rows into data range based on cell values with VBA code

Sometimes, you may need to insert the blank rows based on a list of cell values, in this case, the below VBA code can do you a favor, please do as this:

1. Hold down the ALT + F11 keys in Excel, and it opens the Microsoft Visual Basic for Applications window.

2. Click Insert > Module, and paste the following code in the Module Window.

VBA code: Insert specific number of blank rows based on a list of numbers:

Sub Insertblankrowsbynumbers ()
'UpdatebyExtendoffice
Dim xRg As Range
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Select the spefic number column to use(single column):", "Kutools For Excel", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Row
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Set xRg = xRg(1)
For I = xLastRow To xFstRow Step -1
xNum = Cells(I, xCol)
If IsNumeric(xNum) And xNum > 0 Then
Rows(I + 1).Resize(xNum).Insert
xCount = xCount + xNum
End If
Next
xRg.Resize(xCount, 1).Select
Application.ScreenUpdating = True
End Sub

3. After pasting this code, press F5 key to run this code, in the popped out dialog box,  select the list of numbers that you want to insert blank rows based on, see screenshot:

4. Then, click OK, and you will get the results you need as following screenshots shown:


Insert specific number of blank rows into data range at fixed intervals with a handy feature

If you are not familiar with above VBA code, Kutools for Excel also may help you, its Insert Blank Rows & Columns feature can insert specific number of rows or columns into existing data at fixed intervals quickly and easily.

Note:To apply this Insert Blank Rows & Columns , firstly, you should download the Kutools for Excel, and then apply the feature quickly and easily.

After installing Kutools for Excel, please do as follows:

1. Select the data range that you want to insert blank rows at intervals.

2. Click Kutools > Insert > Insert Blank Rows & Columns, see screenshot:

3. In the Insert Blank Row & Columns dialog box, choose Blank rows option from the Insert type, and then specify the number of interval and blank rows that you want to use as following screenshot shown:

4. Then click OK button, and the blank rows have been inserted into the selected range at a specific interval as following screenshot shown:

Download and free trial Kutools for Excel Now !


Copy and insert rows multiple times based on specific numbers with VBA code

Supposing, you have a range of tada, and now, you want to copy each row and paste them multiple times to the next row based on a list of numbers as below screenshots shown. How could solve this task in Excel worksheet?

To deal with this job, I will introduce a useful code for you, please do with the following steps:

1. Hold down the ALT + F11 keys in Excel, and it opens the Microsoft Visual Basic for Applications window.

2. Click Insert > Module, and paste the following code in the Module Window.

VBA code: Copy and insert rows multiple times based on specific numbers:

Sub CopyRows()
'UpdatebyExtendoffice
Dim xRg As Range
Dim xCRg As Range
Dim xFNum As Integer
Dim xRN As Integer
On Error Resume Next
SelectRange:
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Select the list of numbers to copy the rows based on: ", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub

If xRg.Columns.Count > 1 Then
MsgBox "Please select single column!"
GoTo SelectRange
End If
Application.ScreenUpdating = False
For xFNum = xRg.Count To 1 Step -1
Set xCRg = xRg.Item(xFNum)
xRN = CInt(xCRg.Value)
With Rows(xCRg.Row)
.Copy
.Resize(xRN).Insert
End With
Next
Application.ScreenUpdating = True
End Sub

3. After pasting this code, press F5 key to run this code, in the popped out dialog box, select the list of numbers that you want to copy and insert the data rows based on, see screenshot:

4. Then, click OK button, and the specific number of  rows have been copy and paste under each original row, see screenshots:


Copy and insert rows multiple times based on specific numbers with an amazing feature

If you have Kutools for Excel, with its Duplicate Rows / Columns based on cell value feature, you can insert the rows or columns based on the list of numbers quickly and easily.

Note:To apply this Duplicate Rows / Columns based on cell value, firstly, you should download the Kutools for Excel, and then apply the feature quickly and easily.

After installing Kutools for Excel, please do as follows:

1. Click Kutools > Insert > Duplicate Rows / Columns based on cell value, see screenshot:

2. In the Copy and insert rows & columns dialog box, select Copy and insert rows option in the Type section, then select the data range you want to duplicate, and then specify the list of values that you want to copy rows based on, see screenshot:

4. Then, click Ok or Apply button, you will get the following result as you need:

Download and free trial Kutools for Excel Now !

More relative articles:

  • Copy And Insert Row Multiple Times Or Duplicate The Row X Times
  • In your daily work, have you ever tried to copy a row or each row and then insert multiple times below the current data row in a worksheet? For example, I have a range of cells, now, I want to copy each row and paste them 3 times to the next row as following screenshot shown. How could you deal with this job in Excel?
  • Insert Blank Rows When Value Changes In Excel
  • Supposing you have a range of data, and now you want to insert blank rows between the data when value changes, so that you can separate the sequential same values in one column as following screenshots shown. In this article, I will talk about some tricks for you to solve this problem.
  • Copy Rows From Multiple Worksheets Based On Criteria Into A New Sheet
  • Supposing, you have a workbook with three worksheets which have the same formatting as below screenshot shown. Now, you want to copy all the rows from these worksheets which column C contain the text “Completed” into a new worksheet. How could you solve this problem quickly and easily without copying and pasting them one by one manually?

The Best Office Productivity Tools

Kutools for Excel Solves Most of Your Problems, and Increases Your Productivity by 80%

  • Reuse: Quickly insert complex formulas, charts and anything that you have used before; Encrypt Cells with password; Create Mailing List and send emails...
  • Super Formula Bar (easily edit multiple lines of text and formula); Reading Layout (easily read and edit large numbers of cells); Paste to Filtered Range...
  • Merge Cells/Rows/Columns without losing Data; Split Cells Content; Combine Duplicate Rows/Columns... Prevent Duplicate Cells; Compare Ranges...
  • Select Duplicate or Unique Rows; Select Blank Rows (all cells are empty); Super Find and Fuzzy Find in Many Workbooks; Random Select...
  • Exact Copy Multiple Cells without changing formula reference; Auto Create References to Multiple Sheets; Insert Bullets, Check Boxes and more...
  • Extract Text, Add Text, Remove by Position, Remove Space; Create and Print Paging Subtotals; Convert Between Cells Content and Comments...
  • Super Filter (save and apply filter schemes to other sheets); Advanced Sort by month/week/day, frequency and more; Special Filter by bold, italic...
  • Combine Workbooks and WorkSheets; Merge Tables based on key columns; Split Data into Multiple Sheets; Batch Convert xls, xlsx and PDF...
  • More than 300 powerful features. Supports Office/Excel 2007-2019 and 365. Supports all languages. Easy deploying in your enterprise or organization. Full features 30-day free trial. 60-day money back guarantee.
kte tab 201905

Office Tab Brings Tabbed interface to Office, and Make Your Work Much Easier

  • Enable tabbed editing and reading in Word, Excel, PowerPoint, Publisher, Access, Visio and Project.
  • Open and create multiple documents in new tabs of the same window, rather than in new windows.
  • Increases your productivity by 50%, and reduces hundreds of mouse clicks for you every day!
officetab bottom
Comments (37)
Rated 5 out of 5 · 1 ratings
This comment was minimized by the moderator on the site
Hi, I'm using your code (below) can you please tell me how can fill those rows with custom text into it. I've used your code to enter three rows it worked perfectly but now I need to enter the text Row1 = Date Row2.= Location Row3 = Phone Number Thanks in advance... "Sub InsertRowsAtIntervals() 'Updateby20150707 Dim Rng As Range Dim xInterval As Integer Dim xRows As Integer Dim xRowsCount As Integer Dim xNum1 As Integer Dim xNum2 As Integer Dim WorkRng As Range Dim xWs As Worksheet xTitleId = "KutoolsforExcel" Set WorkRng = Application.Selection Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) xRowsCount = WorkRng.Rows.Count xInterval = Application.InputBox("Enter row interval. ", xTitleId, 1, Type:=1) xRows = Application.InputBox("How many rows to insert at each interval? ", xTitleId, 1, Type:=1) xNum1 = WorkRng.Row + xInterval xNum2 = xRows + xInterval Set xWs = WorkRng.Parent For i = 1 To Int(xRowsCount / xInterval) xWs.Range(xWs.Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).Select Application.Selection.EntireRow.Insert xNum1 = xNum1 + xNum2 Next End Sub"
This comment was minimized by the moderator on the site
thank you so much!!!!! this is amazing
This comment was minimized by the moderator on the site
Thanks AloT!!
This comment was minimized by the moderator on the site
Hi


I use interval vba code its working..But when I use above 100000 rows it not working.. kindly suggest what should I change if any.


Sub InsertRowsAtIntervals()
'Updateby20150707
Dim Rng As Range
Dim xInterval As Integer
Dim xRows As Integer
Dim xRowsCount As Integer
Dim xNum1 As Integer
Dim xNum2 As Integer
Dim WorkRng As Range
Dim xWs As Worksheet
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xRowsCount = WorkRng.Rows.Count
xInterval = Application.InputBox("Enter row interval. ", xTitleId, 1, Type:=1)
xRows = Application.InputBox("How many rows to insert at each interval? ", xTitleId, 1, Type:=1)
xNum1 = WorkRng.Row + xInterval
xNum2 = xRows + xInterval
Set xWs = WorkRng.Parent
For i = 1 To Int(xRowsCount / xInterval)
xWs.Range(xWs.Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).Select
Application.Selection.EntireRow.Insert
xNum1 = xNum1 + xNum2
Next
End Sub
This comment was minimized by the moderator on the site
Fantastic - you saved me a lot of mindless data entry, thank you very much
This comment was minimized by the moderator on the site
hi how can I get the code for Insert specific number of columns into data at fixed intervals
This comment was minimized by the moderator on the site
Hello, PK,
To insert blank columns into existing data at specific intervals, the below VBA code can help you! Please try it.

Sub InsertColumnsAtIntervals()
Dim Rng As Range
Dim xInterval As Integer
Dim xCs As Integer
Dim xCCount As Integer
Dim xNum1 As Integer
Dim xNum2 As Integer
Dim WorkRng As Range
Dim xWs As Worksheet
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xCCount = WorkRng.Columns.Count
xInterval = Application.InputBox("Enter column interval. ", xTitleId, 1, Type:=1)
xCs = Application.InputBox("How many columns to insert at each interval? ", xTitleId, 1, Type:=1)
xNum1 = WorkRng.Column + xInterval
xNum2 = xCs + xInterval
Set xWs = WorkRng.Parent
For I = 1 To Int(xCCount / xInterval)
xWs.Range(xWs.Cells(WorkRng.Row, xNum1 + xCs - 1), xWs.Cells(WorkRng.Row, xNum1)).Select
Application.Selection.EntireColumn.Insert
xNum1 = xNum1 + xNum2
Next
End Sub
This comment was minimized by the moderator on the site
How to add rows in excel data as per mentioned number in last cell say in a excel data if last cell is showing number as 4 , what is the way to dd 4 rows automtically. in another row number is 72, etc
This comment was minimized by the moderator on the site
Hi, SPGupta,
To insert blank rows based on specific number list, please apply the below VBA code.
Please try, hope it can help you!

Sub Insert()
'UpdatebyExtendoffice
Dim xRg As Range
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Select the spefic number column to use(single column):", "KuTools For Excel", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Row
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Set xRg = xRg(1)
For I = xLastRow To xFstRow Step -1
xNum = Cells(I, xCol)
If IsNumeric(xNum) And xNum > 0 Then
Rows(I + 1).Resize(xNum).Insert
xCount = xCount + xNum
End If
Next
xRg.Resize(xCount, 1).Select
Application.ScreenUpdating = True
End Sub
This comment was minimized by the moderator on the site
Hi, could you help me, please? How can I change this code to ad one more less rows than number in cell? For example, if number in cell is 4, program add 3 rows. If number in cell is 1, rows are not aded
This comment was minimized by the moderator on the site
Hi, Nina,
To solve your task, please use the below code:

Sub Insert()
'UpdatebyExtendoffice
Dim xRg As Range
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Select the spefic number column to use(single column):", "KuTools For Excel", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Row
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Set xRg = xRg(1)
For I = xLastRow To xFstRow Step -1
xNum = Cells(I, xCol)
xNum = xNum - 1
If IsNumeric(xNum) And xNum > 0 Then
Rows(I + 1).Resize(xNum).Insert
xCount = xCount + xNum
End If
Next
xRg.Resize(xCount, 1).Select
Application.ScreenUpdating = True
End Sub


Please try, hope it can help you!
This comment was minimized by the moderator on the site
It works perfect, thank you so much!
This comment was minimized by the moderator on the site
This is great. I just wonder... and my English is not perfect so I hope you will understand me :) .....
Is it possible to fill added blank rows with values from row where was that parametric number?
This comment was minimized by the moderator on the site
Hello, Vladimir,Do you mean to insert blank rows based on a list of numbers in the worksheet? If so, please apply the below code:
<div data-tag="code">Sub Insert()
'UpdatebyExtendoffice
Dim xRg As Range
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Select the list of numbers that you want to insert rows based on:", "KuTools For Excel", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Row
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Set xRg = xRg(1)
For I = xLastRow To xFstRow Step -1
xNum = Cells(I, xCol)
If IsNumeric(xNum) And xNum > 0 Then
Rows(I + 1).Resize(xNum).Insert
xCount = xCount + xNum
End If
Next
xRg.Resize(xCount, 1).Select
Application.ScreenUpdating = True
End SubPlease try it, if you have other questions, please comment here.
This comment was minimized by the moderator on the site
This code is perfect for inserting rows....Sub Insert()
'UpdatebyExtendoffice
Dim xRg As Range
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Select the spefic number column to use(single column):", "KuTools For Excel", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Row
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Set xRg = xRg(1)
For I = xLastRow To xFstRow Step -1
xNum = Cells(I, xCol)
xNum = xNum - 1
If IsNumeric(xNum) And xNum > 0 Then
Rows(I + 1).Resize(xNum).Insert
xCount = xCount + xNum
End If
Next
xRg.Resize(xCount, 1).Select
Application.ScreenUpdating = True
End Sub

But is it possible.... copy data in those blank cells from row where was that parametric number? Can i post here picture? Maybe it is easier if I show you what I need :)
This comment was minimized by the moderator on the site
Hi, Vladimir,May be the below VBA code can help you, please try it.<div data-tag="code">Sub CopyRow()
'UpdatebyExtendoffice
Dim xRg As Range
Dim xCRg As Range
Dim xFNum As Integer
Dim xRN As Integer
On Error Resume Next
SelectRange:
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Select the number list", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub

If xRg.Columns.Count > 1 Then
MsgBox "Please select single column!"
GoTo SelectRange
End If
Application.ScreenUpdating = False
For xFNum = xRg.Count To 1 Step -1
Set xCRg = xRg.Item(xFNum)
xRN = CInt(xCRg.Value)
With Rows(xCRg.Row)
.Copy
.Resize(xRN).Insert
End With
Next
Application.ScreenUpdating = True
End Sub

This comment was minimized by the moderator on the site
We are so so close :) All what i need now is one row less than in last VBA code, than is value of parametric number. For example: If the number is 8 we need to insert and copy 7 rows. As you made for Nina just with this COPY
So, if the number is 8 then we should have a total of 8 inserted and copied rows, and with the previous VBA code we have 9.
Tnx
This comment was minimized by the moderator on the site
Hi, In this case, the following code may help you, please try:<div data-tag="code">Sub CopyData()
'Updateby Extendoffice
Dim xRow As Long
Dim VInSertNum As Variant
xRow = 1
Application.ScreenUpdating = False
Do While (Cells(xRow, "A") <> "")
VInSertNum = Cells(xRow, "B")
If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
Range(Cells(xRow, "A"), Cells(xRow, "B")).Copy
Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "B")).Select
Selection.Insert Shift:=xlDown
xRow = xRow + VInSertNum - 1
End If
xRow = xRow + 1
Loop
Application.ScreenUpdating = False
End SubNote: In the above code, the letter A indicates the start column of your data range, and the letter B is the column letter that you want to duplicate the rows based on. Please change them to your need.
This comment was minimized by the moderator on the site
Do you have a module that deducts the copied number by one?
This comment was minimized by the moderator on the site
No. I have this one, but I need it to deduct 1?
Sub CopyRow()
'UpdatebyExtendoffice
Dim xRg As Range
Dim xCRg As Range
Dim xFNum As Integer
Dim xRN As Integer
On Error Resume Next
SelectRange:
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Select the number list", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub

If xRg.Columns.Count > 1 Then
MsgBox "Please select single column!"
GoTo SelectRange
End If
Application.ScreenUpdating = False
For xFNum = xRg.Count To 1 Step -1
Set xCRg = xRg.Item(xFNum)
xRN = CInt(xCRg.Value)
With Rows(xCRg.Row)
.Copy
.Resize(xRN).Insert
End With
Next
Application.ScreenUpdating = True
End Sub
This comment was minimized by the moderator on the site
What I am trying to do is create and print labels in Word from a spreadsheet with multiple quantities?
This comment was minimized by the moderator on the site
Have you had a chance to look at this?
This comment was minimized by the moderator on the site
Gold bless you
This comment was minimized by the moderator on the site
Looking for code to generate an excel list duplicating by a number in a cell and subtracting 1 for the original?
This comment was minimized by the moderator on the site
Thank you author! You deserve the best commendation for these! But please could you help me out with the code to put a constant value into all blank rows I created with your code above? To make myself more clearer, I need to insert a constant value into all blank rows (this solved already with your code above) then I need to insert a constant value into all of the blank rows (this is my problem). Thank you as I expect your kind response.
This comment was minimized by the moderator on the site
Hello, Do you mean to fill blank rows with specific value? If so, mabe the following article cna help you:https://www.extendoffice.com/documents/excel/772-excel-fill-blank-cells-with-0-or-specific-value.html
Please try it.
This comment was minimized by the moderator on the site
Can I get the VBA code for deletion of rows based on duplicate values in a selected column keeping all unique values?
This comment was minimized by the moderator on the site
Hello, Roy,If you want to remove rows based on duplicate values, normally, you can use the Remove Duplicates feature in Excel to remove the rows.Of course, if you need a VBA code, please use the below code: (First, you should select the data range that you want to remove, and then run this code, the rows based on the duplicate values in the first column of your selection will be removed at once. )<div data-tag="code">Sub Delete_duplicate_rows()
Dim Rng As Range
Set Rng = Selection
Rng.RemoveDuplicates Columns:=Array(1), Header:=xlYes
End SubPlease try, hope it can help you!
This comment was minimized by the moderator on the site
This is so Cool!! Thanks a lot
This comment was minimized by the moderator on the site
Muito obrigado, salvou meu trabalho, eu não tinha ideia de como fazer. Muito obrigado mesmo!
This comment was minimized by the moderator on the site
Hello,
You are welcome. Glad it helps. Any questions, please feel free to contact us. Have a great day.
Sincerely,
Mandy
This comment was minimized by the moderator on the site
can you tell me how to insert column like this way , what is the code
This comment was minimized by the moderator on the site
Hello friend,
You can use this VBA code:

Sub InsertColumnsAtIntervals()

'Updateby Extendoffice

Dim Rng As Range

Dim xInterval As Integer

Dim xColumns As Integer

Dim xColumnsCount As Integer

Dim xNum1 As Integer

Dim xNum2 As Integer

Dim WorkRng As Range

Dim xWs As Worksheet

xTitleId = "KutoolsforExcel"

Set WorkRng = Application.Selection

Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

xColumnsCount = WorkRng.Columns.Count

xInterval = Application.InputBox("Enter column interval. ", xTitleId, 1, Type:=1)

xColumns = Application.InputBox("How many columns to insert at each interval? ", xTitleId, 1, Type:=1)

xNum1 = WorkRng.Column + xInterval

xNum2 = xColumns + xInterval

Set xWs = WorkRng.Parent

For i = 1 To Int(xColumnsCount / xInterval)

    xWs.Range(xWs.Cells(WorkRng.Row, xNum1), xWs.Cells(WorkRng.Row, xNum1 + xColumns - 1)).Select

    Application.Selection.EntireColumn.Insert

    xNum1 = xNum1 + xNum2

Next

End Sub


Sincerely,
Mandy
This comment was minimized by the moderator on the site
Вот выручили так выручили!
Сидел, ломал голову как добавить строки по заданному количеству.
Ваш макрос мне очень помог.
Rated 5 out of 5
This comment was minimized by the moderator on the site
Name Email Phone Address
0 Name Email Phone Adress
address line 2 Name Phone 0
Name Email Phone Adress
0 Name Email Phone Adress
address line 2 0


How could I edit this to start a new row at every empty value or 0 value without having phone numbers with 0 start a new row?
This comment was minimized by the moderator on the site
Hello, Jarrod

Sorry, I can't get your problem clearly.
Could you explain your problem more detailed? Or you can insert a screenshot or file here.
Thank you!
This comment was minimized by the moderator on the site
hola, hay algun codigo que me permita copiar los datos, pero que en la primera columna que son fechas pueda ser consecutivo.

ejemplo

en vez de que quede asi

01/10/2022 19.258.369-4 Juan Ramirez
01/10/2022 19.258.369-4 Juan Ramirez
01/10/2022 19.258.369-4 Juan Ramirez

quede asi

01/10/2022 19.258.369-4 Juan Ramirez
02/10/2022 19.258.369-4 Juan Ramirez
03/10/2022 19.258.369-4 Juan Ramirez

gracias
There are no comments posted here yet
Leave your comments
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations