Ускорение макроса

[ymnuhj]

Нужно было сделать процедуру что вставляла бы нужное кол-во строк сразу на листа. Сделать то получилось, однако три строчки по 8 секунд вставляются. Можно ли как то ускорить этот макрос?

Sub AddNewRaws()
Application.ScreenUpdating = False

n = 97 'номер строки куда вставлять
k = 7 'кол-во вставляемых строк

Sheets(1).Select
For i = n To n + k - 1
    Rows(i).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     With Selection.Interior' удаляю заливку (форматирование копируется сверху и заливка всместе с ним)
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Next i

Sheets(2).Select
For i = n To n + k - 1
    Rows(i).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Next i

Sheets(3).Select
For i = n To n + k - 1
    Rows(i).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next i

Application.ScreenUpdating = True
End Sub

Заранее спасибо

[alex77755]

For i = n To n + k - 1
    Rows(i).Select

А зачем это всё? Почему нельзя вставить без цикла нужное количество строк?
Вот что записал макрорекордеря только чуток поправил)

    Rows("7:16").Insert Shift:=xlDown
    Selection.Interior.ColorIndex = xlNone

[ymnuhj]

Да, это то что нужно. Спасибо
Только как засунуть две переменные под скобочки в raws (начальный и конечный номер промежутка), дабы каждый раз в ВБА редактор не лазить и не менять их в коде?

[ShAM66]

Rows(i & ":" & j)

[ymnuhj]

Да,работает. Спасибо за новый прием.

Стало быстрей но все равно пару секунд приходится ждать. Можно конечно так и оставить, не смертельно.

Только вот все-таки интересно максимальная это скорость или нет?

Sub AddNewRaws()
Application.ScreenUpdating = False

k = 100 'number of raw
m = 3 'amount of raws to insert
n = k + m - 1 

Sheets(1).Rows(k & ":" & n).Insert Shift:=xlDown
Selection.Interior.ColorIndex = xlNone
   
Sheets(2).Rows(k & ":" & n).Insert Shift:=xlDown
Selection.Interior.ColorIndex = xlNone

Sheets(3).Rows(k & ":" & n).Insert Shift:=xlDown
Selection.Interior.ColorIndex = xlNone

Application.ScreenUpdating = True
End Sub

[Казанский]

Да,работает
И заливка удаляется?
Вот Вам еще пара приемов.

Sub AddNewRaws()
Application.ScreenUpdating = False

k = 100 'number of raw
m = 3 'amount of raws to insert
'n = k + m - 1

For n = 1 To 3
    Sheets(n).Rows(k).Resize(m).Insert Shift:=xlDown
    Sheets(n).Rows(k).Resize(m).Interior.ColorIndex = xlNone
Next

Application.ScreenUpdating = True
End Sub