Макрос Добавление строк

[tracklist]

Добрый день! Не нашёл уже готового решения, поэтому прошу помочь.
Есть список в excel-файле, тысячи строк. После каждой строки (или перед каждой, непринципиально) нужно вставить 2 пустые строки...
Попоробовал сам записать макрос, но результат не тот.

[Дмитрий Щербаков(The_Prist)]

Код: (vb)

Sub Insert_Rows()
    Dim lLastRow As Long, li As Long
    Application.ScreenUpdating = 0
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For li = lLastRow To 1 Step -1
        Rows(li).Resize(2).Insert
    Next li
    Application.ScreenUpdating = 1
End Sub

[tracklist]

The_Prist, вы просто Бог макросов! Сердечно благодарю!

[Kosha]

Добрый день! Не хочу плодить похожие темы, поэтому напишу в этой) Есть макрос, который вставляет то кол-во строчек, которое указано в ячейке. Но таблица большая, а вставляет он по одной и процесс долгий, а как макрос усовершенствовать не пойму( Надо чтоб он не по одной вставлял, а сразу то кол-во, которое нужно. Хелп плиз!

Код: (vb)

Sub aaa()

Sheets("Лист5").Activate

r = 3
Do Until IsEmpty(Sheets("Лист5").Cells(r, 2))
    If Sheets("Лист5").Cells(r, 4) < 0 Then
        RowNumb = Sheets("Лист5").Cells(r, 4).Value
        Sheets("Лист5").Rows(r).Select
    For i = 1 To -RowNumb
        Selection.Insert Shift:=xlDown
    Next
    Range(Cells(r - 2, 2), Cells(r - 1, 2)).Select
    Selection.AutoFill Destination:=Range(Cells(r - 2, 2), Cells(r, 2)), Type:=xlFillDefault
    Selection.AutoFill Destination:=Range(Cells(r - 2, 2), Cells(50000, 2))
    End If
    
    r = r + 1
Loop

End Sub

[Дмитрий Щербаков(The_Prist)]

Чем мой код выше не устраивает?

Код: (vb)

Sub Insert_Rows()  
    Dim lLastRow As Long, li As Long  
    Application.ScreenUpdating = 0  
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row  
    For li = lLastRow To 1 Step -1  
        Rows(li).Resize(2).Insert  
    Next li  
    Application.ScreenUpdating = 1  
End Sub

В строке: Rows(li).Resize(2).Insert  вместо 2 указываете необходимое кол-во строк для вставки.

[andkom]

Подскажи что поменять в вашем коде чтобы строчки добавлялись не через каждую, а через три, плиз очень нужно

[Kuzmich]

чтобы строчки добавлялись не через каждую, а через три

Код: (vb)

For li = lLastRow To 1 Step -3

[andkom]

если делаю вот так

Код: (vb)

Sub Insert_Rows()    
    Dim lLastRow As Long, li As Long    
    Application.ScreenUpdating = 0    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row    
    For li = lLastRow To 1 Step -2    
        Rows(li).Resize(2).Insert    
    Next li    
    Application.ScreenUpdating = 1    
End Sub

 
то все нормально работает
если так

Код: (vb)

Sub Insert_Rows()    
    Dim lLastRow As Long, li As Long    
    Application.ScreenUpdating = 0    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row    
    For li = lLastRow To 1 Step -3    
        Rows(li).Resize(3).Insert    
    Next li    
    Application.ScreenUpdating = 1    
End Sub

то получается почему то так
1
1

2
2
2

3
3
3
помогите поправит чтоб была вот так
1
1
1

2
2
2

3
3
3

[Kuzmich]

помогите поправит чтоб была вот так

Попробуйте так

Код: (vb)

Sub Insert_Rows()
    Dim lLastRow As Long, li As Long
    Application.ScreenUpdating = 0
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For li = lLastRow To 1 Step -3
        Rows(li + 1).Resize(3).Insert
    Next li
    Application.ScreenUpdating = 1
End Sub

[andkom]

Спасибо, очень помогли)))

[vladmv]

Добрый день!
Прошу помочь. Нужен макрос - одновременно добавить строку на трех листах "Лист1","Лист2","Лист3"

Спасибо

[Дмитрий Щербаков(The_Prist)]

Ну раз не написали куда именно, по каким условиям...Вот, код добавляет строку в три листа:

Код: (vb)

Sub Insert_Rows()
    Dim arr, x
    Application.ScreenUpdating = 0
    For Each x In Array("Лист1", "Лист2", "Лист3")
        ActiveWorkbook.Sheets(x).Rows(3).Insert
    Next
    Application.ScreenUpdating = 1
End Sub

добавляет перед третьей строкой.
Так же это можно сделать таким кодом:

Код: (vb)

Sub Insert_Rows_2()
    Sheets(Array("Лист1", "Лист2", "Лист3")).Select
    Rows(3).Insert
    Sheets("Лист1").Select
End Sub

подпиливайте под свои условия.

[vladmv]

Спасибо большое! Почти!

Нужно, чтобы строка вставлялась на той строке, на которой стоит курсор!
Сделал вот так:
     ActiveWorkbook.Sheets(x).Rows(ActiveCell.Row).Insert

[Pavel.Bard]

Судя по количеству просмотров, тема хоть и старая, но важная.
Когда мне надо вставить строки "через одну" в огромный файл, да ещё и с формулами, сначала тоже писал макросы, но если в файле пол миллиона строк, а надо, например, после каждой пары вставить строку с формулами, то макросом очень долго.
Реальная задача - есть данные по 250 тыс позиций за два года, год к году, надо вставить строки с динамикой. Решение (время обработки - минута-полторы):
1. Добавляю пустую колонку, в первые две строки ставлю 1 и 2
2. В остальные строки - формулу =r[-2]c+3, таким образом в колонке будет 1 2 4 5 7 8 ... 450001 450002.
3. В первую пустую строку ставлю 3 в первой колонке, далее столько, сколько надо =r[-1]c+3, то есть будет 3 6 9 ... 450003
4. В той строке, у которой "3" в первой колонке, выписываем необходимые формулы, ссылающиеся на две предыдущие строки.
5. Размножаем формулы до низа, не обращая внимания на возможные деления на ноль, переполнения и пр.
6. ВАЖНО! Заменяем формулы в первой колонке значениями.
7. Сортируем по первой колонке
8. Удаляем эту рабочую колонку.
Всё!!!

[badul]

Здравствуйте.
Помогите пожалуйста автоматизировать форму акта..
Цель 1: не иметь пустых строк в акте для списания материалов. Т.е. иметь "подвижную" таблицу. Добавлять последнюю строку в таблице по нажатию на кнопки или убирать последнюю строку (в зависимости от наполнения таблицы) чтобы в ней не было пустых
Цель 2: добавлять убирать членов комиссии (позиции над таблицой и подписи под таблицей)

Спасибо за возможную помощь.