После каждой заполненной ячейки столбца вставлять пустую строку

'Процедура вставляет строки и столбцы фиксированного размера,
'после заданного количества строк/столбцов.
Sub InsertingRowsColumns()
   Const AFTER_NROWS As Long = 1 'Новая строка будет после каждых AFTER_NROWS строк.
   Const AFTER_NCOLS As Long = 2 'Новый столбец - после каждых AFTER_NCOLS столбцов.
   Const RHEIGHT As Byte = 3     'Высота новой строки будет равна RHEIGHT пикселям.
   Const CWIDTH As Byte = 3      'Ширина нового столбца будет равна CWIDTH пикселям.
   Dim k As Byte, i As Long, n As Long
   Application.ScreenUpdating = False
   With ActiveSheet.UsedRange    'Вставка - только в пределах используемого диапазона.
      For k = 0 To 1             'При k = 0 обрабатываем строки, при k = 1 - столбцы.
         If IIf(k, AFTER_NCOLS, AFTER_NROWS) > 0 Then
            With IIf(k, .Columns, .Rows)
               i = 0
               n = .Count
               While i < n
                  i = i + IIf(k, AFTER_NCOLS, AFTER_NROWS) + 1
                  .Item(i).Insert   'Вставка новой строки/столбца.
                  If k Then         'Задание размера новой строки/столбца.
                     .Item(i).ColumnWidth = CWIDTH * 0.06
                  Else
                     .Item(i).RowHeight = RHEIGHT * 0.75
                  End If
                  n = n + 1
               Wend
            End With
         End If
      Next k
   End With
   Application.ScreenUpdating = True
End Sub