Копируется одно и тоже, но разное количество строк.
Вот начал писать через копи паст с другого листа,но копирует только 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