Макрос на равставки строк с текстом

[Blackeangel]

В общем помогите написать код для вставки 2 строк от первой до последней на листе с учетом имеющейся в них фразах.Например,если в строке по всем столбцам есть слово Олень,то мы вставляем 2 строки над этой строкой,если нет,то пропускаем или (что лучше) ищем по другому условию. Заполняются они в самом коде либо как вариант копируются с другого листа. Количество строк - столько сколько поддерживает эксель(точнее более 180000)
Копируется одно и тоже, но разное количество строк.
Вот начал писать через копи паст с другого листа,но копирует только 1 значение и один раз,что опять не по циклу.

Sub Insert_Rows()
    Dim lLastRow As Long, li As Long, i As Range ' переменные
    Application.ScreenUpdating = 0 'заморозим экран от изменений
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'переменной присваиваетс¤ последн¤¤ строка
    For li = lLastRow To 1 Step -1 'ѕ≈–≈Ѕ»–ј≈ћ — последней до первой строки с шагом -1
    Sheets("Ћист2").Select
    ActiveCell.Rows("1:2").EntireRow.Select
    Selection.Copy
    Sheets("Ћист1").Select
    ActiveCell.Rows().EntireRow.Select
    Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Next li
    Application.ScreenUpdating = 1 'разморозили экран и он обновилс¤
End Sub

но тут не работает поиск,он ищет только первое значение и вставляет пустые строки.

' это вставка двух строк при нахождении фразы,но в выделенной ¤чейке
Sub StrokaAfterSumm()
Attribute StrokaAfterSumm.VB_ProcData.VB_Invoke_Func = "f\n14"
Dim i As Range
Application.ScreenUpdating = 0
  For Each i In Selection
    If i = "3311св" Then i.Offset(-1, 0).EntireRow.Resize(2).Insert xlDown
  Next
  Application.ScreenUpdating = 1
End Sub
' Ёто вставка 2 строк до
Sub Insert_Rows()
Attribute Insert_Rows.VB_ProcData.VB_Invoke_Func = "ф\n14"
    Dim lLastRow As Long, li As Long, i As Range ' переменные
    Application.ScreenUpdating = 0 'заморозим экран от изменений
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'переменной присваиваетс¤ последн¤¤ строка
    For li = lLastRow To 1 Step -1 'ѕ≈–≈Ѕ»–ј≈ћ — последней до первой строки с шагом -1
'поиск и добавление строк, в for не работает -->
    Cells.Find(What:="3311св", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
  '  Cells.FindNext(After:=ActiveCell).Activate
'   Cells.Find(What:="3311св", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Offset(-1, 0).EntireRow.Resize(2).Insert xlDown
'<--
     '  Rows(li).Resize(2).Insert 'добавл¤ем 2 строки до нужной нам
' если заменить Resize(2) на Resize(1) то будет вставл¤тьс¤ только одна строка
    Next li
    Application.ScreenUpdating = 1 'разморозили экран и он обновилс¤
End Sub
' это вставка двух строк при нахождении фразы,но в выделенной ¤чейке
Sub StrokaAfterSumm2()
Dim i As Range
Application.ScreenUpdating = 0
 ' For Each i In ActiveWorkbook.Worksheets
  Range("A:A").Find("3311св").Offset(-1, 0).EntireRow.Resize(2).Insert xlDown
   'If i = "3311св" Then i.Offset(-1, 0).EntireRow.Resize(2).Insert xlDown
  'Next i
  Application.ScreenUpdating = 1
End Sub

Файл прилагаю.

[Кардаган]

Сообщение от Blackeangel

В общем помогите написать код для вставки 2 строк от первой до последней на листе

Это как? Вставляем 2 строки. 1- первая, 2 - последняя. И что значит "от первой до последней"?

Сообщение от Blackeangel

Копируется одно и тоже, но разное количество строк.

Так одно и тоже или разное?
ПС: файл можно и без архива прикладывать.

[Blackeangel]

Сообщение от Кардаган

Это как? Вставляем 2 строки. 1- первая, 2 - последняя. И что значит "от первой до последней"?

Так одно и тоже или разное?
ПС: файл можно и без архива прикладывать.

1.от первой до последней на листе в которой содержится текст
2.содержимое одно и то же(например если Олень то 2 строки с Лось;а если Медведь, то одна строка со словом Ящик)
3.Без архива перебор по весу для форума

[27102014]

Blackeangel, Вы выложили файл, потрудитесь объяснить что нужно с ним сделать - т.е. составьте условия задачи, которую нужно решить, желательно без "оленей", "медведей" и другой живности - у Вас есть конкретные обозначения - СГКА.304591.026, например.

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

[Blackeangel]

Сообщение от 27102014

Blackeangel, Вы выложили файл, потрудитесь объяснить что нужно с ним сделать - т.е. составьте условия задачи, которую нужно решить, желательно без "оленей", "медведей" и другой живности - у Вас есть конкретные обозначения - СГКА.304591.026, например.

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

В самом файле пример как есть и как должно быть. Обозначение это например абсолютно левое и там может быть написан СТОлб.
Основные критерии это 3311св, 5г, 5кр.
Задача. Найти все строки(расположение 3311св может быть в любом столбце любой строки листа,а не только в А) с текстом 3311св, перед ними добавить 2 строки, заполненые текстом как это указано на следующем листе.(грубо говоря скопировать).
Так же проделать это с 5г и 5кр, но при условии что если есть оба (5г-5кр) то вставлять надо перед 5г одну строку,а если они раздельно то перед каждым и по одной строке.
как по мне так if в if'e, но это не паскаль и не си, поэтому не знаю как тут.