Макрос на вставку строк

[dirih]

Привет всем, подскажите начинающему, по макросу на вставку строк. почему то диапазон слетает, бьюсь 2-й день, в чем тут ошибка, нужно вставить строку через каждые 11 строк????

Sub Макрос12()
'
' Макрос12 Макрос
'
' Сочетание клавиш: Ctrl+ф
'
ActiveCell.Offset(10, 0).Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(11, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(11, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(11, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(11, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(11, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(11, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(11, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(11, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(11, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(11, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(11, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(11, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(11, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(11, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(11, 0).Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
ActiveCell.Offset(-20, 2).Range("A1").Select
ActiveCell.Offset(-26, 0).Range("A1").Select
ActiveCell.Offset(-25, 0).Range("A1").Select
ActiveCell.Offset(-26, 0).Range("A1").Select
ActiveCell.Offset(-25, 0).Range("A1").Select
ActiveCell.Offset(-25, 0).Range("A1").Select
ActiveCell.Offset(-26, 0).Range("A1").Select
ActiveCell.Offset(-23, 0).Range("A1").Select
End Sub

[dirih]

может кто подскажет ошибку или же метод попроще )))

[Hugo121]

Ужас, аж в глазах рябит
Идите циклом снизу вверх - если я правильно понял...

[IgorGO]

for r = 1000 to 10 step -11
  rows(r).insert Shift:=xlDown
next

[dirih]

что то, я ничё не понял, может поможете с макросами?

[IgorGO]

да, не угадал два раза, что последняя строка 198 и что на самом деле вставлять необходимо через 12 строк, а не через 11.

Sub AddTrough12Rows()
  const шаг As Long = 12
  For r = 198 To 1 Step -шаг
    Rows(r).Insert Shift:=xlDown
    Cells(r, 2) = шаг
  Next
End Sub

[dirih]

ты был прав, это я после по 1-й строке добавил и скинул = получилось 12
СПС, здорово! как всё просто, но вставляются лишь пустые строки... и опять не ровно ))

[dirih]

вот исправил