Note: The other languages of the website are Google-translated. Back to English
Увійти  \/ 
x
or
x
Реєстрація  \/ 
x

or

Як вставити певну кількість рядків через фіксовані інтервали в Excel?

На аркуші Excel ви можете вставити порожній рядок між існуючими рядками за допомогою функції Вставити. Але якщо у вас великий діапазон даних, і вам потрібно вставити два порожні рядки після кожного третього рядка, як можна швидко і зручно закінчити цю роботу?


Вставте певну кількість порожніх рядків у діапазон даних через фіксовані інтервали з кодом VBA

Наступний код VBA може допомогти вам вставити певну кількість рядків після кожного n-го рядка в існуючі дані. Будь ласка, виконайте наступне:

1. Утримуйте клавішу ALT + F11 клавіші в Excel, і він відкриває Microsoft Visual Basic для додатків вікна.

2. Клацання Insert > Модуліта вставте наступний код у Вікно модуля.

Код VBA: Вставте певну кількість рядків у дані через фіксовані інтервали

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. Після вставки цього коду, натисніть F5 клавіші для запуску цього коду, вискакує підказка з нагадуванням про вибір діапазону даних, до якого потрібно вставити порожні рядки, див. знімок екрана:

4. Клацання OK , з'явиться інше вікно запиту, введіть кількість інтервалів між рядками, див. знімок екрана:

5. Продовжуйте натискати OK , у наступному спливаючому вікні запиту введіть кількість порожніх рядків, які потрібно вставити, див. знімок екрана:

6. Потім натисніть OK, а порожні рядки регулярно вставляються в існуючі дані, див. скріншоти:


Вставте певну кількість порожніх рядків у діапазон даних на основі значень комірок із кодом VBA

Іноді вам може знадобитися вставити порожні рядки на основі списку значень комірок, у цьому випадку наведений нижче код VBA може зробити вам послугу, зробіть так:

1. Утримуйте клавішу ALT + F11 клавіші в Excel, і він відкриває Microsoft Visual Basic для додатків вікна.

2. Клацання Insert > Модуліта вставте наступний код у Вікно модуля.

Код VBA: Вставте певну кількість порожніх рядків на основі списку чисел:

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. Вставивши цей код, натисніть F5 клавіші для запуску цього коду, у спливаючому діалоговому вікні виберіть список чисел, на основі яких потрібно вставити порожні рядки, див. знімок екрана:

4. Потім натисніть кнопку OK, і ви отримаєте потрібні результати, як показано на наступних скріншотах:


Вставте певну кількість порожніх рядків у діапазон даних з фіксованими інтервалами за допомогою зручної функції

Якщо ви не знайомі з наведеним вище кодом VBA, Kutools для Excel також може допомогти вам, його Вставити порожні рядки та стовпці функція може вставляти певну кількість рядків або стовпців у існуючі дані через фіксовані інтервали швидко і легко.

Примітка:Щоб застосувати це Вставити порожні рядки та стовпці , по-перше, вам слід завантажити Kutools для Excel, а потім швидко та легко застосувати функцію.

після установки Kutools для Excel, будь ласка, виконайте наступне:

1. Виберіть діапазон даних, до якого потрібно вставляти порожні рядки з інтервалами.

2. Клацання Кутулс > Insert > Вставити порожні рядки та стовпці, див. скріншот:

3, в Вставити порожній рядок і стовпці діалогове вікно, виберіть Пусті ряди варіант з Вставити тип, а потім вкажіть кількість інтервалів і порожніх рядків, які ви хочете використовувати, як показано на наступному скріншоті:

4. Потім натисніть OK , а порожні рядки були вставлені у вибраний діапазон з певним інтервалом, як показано на наступному знімку екрана:

Завантажте та безкоштовну пробну версію Kutools для Excel зараз!


Копіюйте та вставляйте рядки кілька разів на основі певних чисел за допомогою коду VBA

Припустимо, у вас є діапазон тада, і тепер ви хочете скопіювати кожен рядок і вставити їх кілька разів у наступний рядок на основі списку чисел, як показано на скріншотах нижче. Як можна вирішити це завдання на аркуші Excel?

Щоб розібратися з цією роботою, я представив вам корисний код, виконайте такі дії:

1. Утримуйте клавішу ALT + F11 клавіші в Excel, і він відкриває Microsoft Visual Basic для додатків вікна.

2. Клацання Insert > Модуліта вставте наступний код у Вікно модуля.

Код VBA: Копіюйте та вставляйте рядки кілька разів на основі конкретних чисел:

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. Вставивши цей код, натисніть F5 для запуску цього коду, у спливаючому діалоговому вікні виберіть список чисел, які потрібно скопіювати, та вставте рядки даних на основі, див. знімок екрана:

4. Потім натисніть кнопку OK , а конкретну кількість рядків було скопійовано та вставлено під кожен вихідний рядок, див. скріншоти:


Копіюйте та вставляйте рядки кілька разів на основі конкретних цифр із дивовижною особливістю

Якщо у вас є Kutools для Excel, З його Повторювані рядки / стовпці на основі значення комірки Ви можете швидко та легко вставляти рядки або стовпці на основі списку номерів.

Примітка:Щоб застосувати це Повторювані рядки / стовпці на основі значення комірки, по-перше, вам слід завантажити Kutools для Excel, а потім швидко та легко застосувати функцію.

після установки Kutools для Excel, будь ласка, виконайте наступне:

1. Клацання Кутулс > Insert > Повторювані рядки / стовпці на основі значення комірки, див. скріншот:

2, в Скопіюйте та вставте рядки та стовпці діалогове вікно, виберіть Скопіюйте та вставте рядки опція в тип розділу, потім виберіть діапазон даних, який потрібно скопіювати, а потім вкажіть список значень, на основі яких потрібно скопіювати рядки, див. знімок екрана:

4. Потім натисніть кнопку Ok or Застосовувати , ви отримаєте такий результат, як вам потрібно:

Завантажте та безкоштовну пробну версію Kutools для Excel зараз!

Більше відносних статей:

  • Скопіюйте та вставте рядок кілька разів або продублюйте рядок X разів
  • Чи намагалися ви у своїй щоденній роботі копіювати рядок або кожен рядок, а потім вставляти кілька разів нижче поточного рядка даних на аркуші? Наприклад, у мене є ряд комірок, тепер я хочу скопіювати кожен рядок і вставити їх 3 рази в наступний рядок, як показано на наступному знімку екрана. Як ви могли впоратися з цією роботою в Excel?
  • Вставляйте порожні рядки при зміні значення в Excel
  • Припустимо, у вас є діапазон даних, і тепер ви хочете вставити порожні рядки між даними, коли значення змінюється, щоб ви могли відокремити послідовні однакові значення в одному стовпці, як показано на наступних скріншотах. У цій статті я розповім про деякі трюки для вирішення цієї проблеми.
  • Скопіюйте рядки з декількох аркушів на основі критеріїв у новий аркуш
  • Припустимо, у вас є робоча книга з трьома робочими аркушами, які мають те саме форматування, що показано нижче. Тепер ви хочете скопіювати всі рядки з цих аркушів, стовпець C яких містить текст «Завершено», на новий аркуш. Як ви могли швидко та легко вирішити цю проблему, не копіюючи та не вставляючи їх по черзі вручну?

Найкращі інструменти для підвищення продуктивності офісу

Kutools для Excel вирішує більшість ваших проблем і збільшує продуктивність на 80%

  • Повторне використання: Швидко вставте складні формули, діаграми і все, що ви використовували раніше; Шифрувати комірки з паролем; Створити список розсилки та надсилати електронні листи ...
  • Супер формула бар (легко редагувати кілька рядків тексту та формули); Макет читання (легко читати та редагувати велику кількість комірок); Вставте у відфільтрований діапазон...
  • Об’єднати клітинки / рядки / стовпці без втрати даних; Вміст розділених комірок; Об'єднати повторювані рядки / стовпці... Запобігання дублюючим клітинам; Порівняйте діапазони...
  • Виберіть Повторюваний або Унікальний Рядки; Виберіть Пусті рядки (усі клітинки порожні); Супер знахідка та нечітка знахідка у багатьох робочих зошитах; Випадковий вибір ...
  • Точна копія Кілька клітинок без зміни посилання на формулу; Автоматичне створення посилань на кілька аркушів; Вставте кулі, Прапорці та інше ...
  • Витяг тексту, Додати текст, Видалити за позицією, Видаліть пробіл; Створення та друк проміжних підсумків підкачки; Перетворення вмісту комірок та коментарів...
  • Супер фільтр (зберегти та застосувати схеми фільтрів до інших аркушів); Розширене сортування за місяцем / тижнем / днем, частотою та іншим; Спеціальний фільтр жирним, курсивом ...
  • Поєднайте робочі зошити та робочі аркуші; Об’єднати таблиці на основі ключових стовпців; Розділіть дані на кілька аркушів; Пакетне перетворення xls, xlsx та PDF...
  • Понад 300 потужних функцій. Підтримує Office / Excel 2007-2019 та 365. Підтримує всі мови. Простота розгортання на вашому підприємстві чи в організації. Повна функція 30-денної безкоштовної пробної версії. 60-денна гарантія повернення грошей.
вкладка kte 201905

Вкладка Office забезпечує інтерфейс з вкладками для Office і значно спрощує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
дно офісної таблиці
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    AyMeadows · 19 days ago
    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.
  • To post as a guest, your comment is unpublished.
    GEVERHART · 6 months ago
    Looking for code to generate an excel list duplicating by a number in a cell and subtracting 1 for the original?
  • To post as a guest, your comment is unpublished.
    Conk · 1 years ago
    Gold bless you
  • To post as a guest, your comment is unpublished.
    SPGupta · 2 years ago
    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
    • To post as a guest, your comment is unpublished.
      skyyang · 2 years ago
      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
      • To post as a guest, your comment is unpublished.
        Nina · 1 years ago
        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
        • To post as a guest, your comment is unpublished.
          skyyang · 1 years ago
          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!
          • To post as a guest, your comment is unpublished.
            Vladimir · 10 months ago
            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?
            • To post as a guest, your comment is unpublished.
              skyyang · 10 months ago
              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:

              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 Sub
              Please try it, if you have other questions, please comment here.
              • To post as a guest, your comment is unpublished.
                Vladimir · 10 months ago
                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 :)
                • To post as a guest, your comment is unpublished.
                  skyyang · 10 months ago
                  Hi, Vladimir,
                  May be the below VBA code can help you, please try it.
                  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


                  • To post as a guest, your comment is unpublished.
                    Vladimir · 9 months ago
                    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
                    • To post as a guest, your comment is unpublished.
                      GEVERHART · 6 months ago
                      Do you have a module that deducts the copied number by one?
                      • To post as a guest, your comment is unpublished.
                        GEVERHART · 6 months ago
                        Have you had a chance to look at this?
                      • To post as a guest, your comment is unpublished.
                        GEVERHART · 6 months ago
                        What I am trying to do is create and print labels in Word from a spreadsheet with multiple quantities?
                      • To post as a guest, your comment is unpublished.
                        GEVERHART · 6 months ago
                        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
                    • To post as a guest, your comment is unpublished.
                      skyyang · 9 months ago
                      Hi,
                      In this case, the following code may help you, please try:
                      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 Sub
                      Note: 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.
          • To post as a guest, your comment is unpublished.
            Nina · 1 years ago
            It works perfect, thank you so much!
  • To post as a guest, your comment is unpublished.
    PK · 2 years ago
    hi how can I get the code for Insert specific number of columns into data at fixed intervals
    • To post as a guest, your comment is unpublished.
      skyyang · 2 years ago
      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
  • To post as a guest, your comment is unpublished.
    Martin · 3 years ago
    Fantastic - you saved me a lot of mindless data entry, thank you very much
  • To post as a guest, your comment is unpublished.
    Manish · 3 years ago
    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
  • To post as a guest, your comment is unpublished.
    Atif · 4 years ago
    Thanks AloT!!
  • To post as a guest, your comment is unpublished.
    Stephanie · 4 years ago
    thank you so much!!!!! this is amazing
  • To post as a guest, your comment is unpublished.
    Farooq · 5 years ago
    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"