Здравствуйте, нашел тут на форуме замечательный макрос,
Скрытый текст
Sub InsBRows() Dim r&: r = 2 Do While Not IsEmpty(Cells(r, 2)) Cells(r + 1, 1).Resize(Cells(r, 2), 1).EntireRow.Insert: r = r + 1 + Cells(r, 2) Loop End Sub
который добавляет строки по значению из столбца, то есть если значение 1 добавит +1 строку, знач 2 добавит +2, итд но мне нужно что бы при значении 1 ничего не добавил, при значении 2 добавил +1 строку и тд, помогите пожалуйста, что нужно исправить.
Do While Not IsEmpty(Cells(r, 2).Value)
If Cells(r, 2).Value > 1 Then
Cells(r + 1, 1).Resize(Cells(r, 2).Value - 1, 1).EntireRow.Insert: r = r + Cells(r, 2)
Else
r = r + 1
End If
Loop
Цитата
Евген1788 написал: нашел тут на форуме замечательный макрос
Нормальный, но не замечательный... Добавлять строки правильнее снизу вверх. Еще один не замечательный, но правильный код )
Код
Sub InsBRows_2()
Dim r&
With ActiveSheet
'r = .UsedRange.Rows.Count + .UsedRange.Row - 1
r = .Cells(.Rows.Count, 2).End(xlUp).Row
Do
If .Cells(r, 2).Value > 1 Then
.Cells(r + 1, 1).Resize(.Cells(r, 2).Value - 1, 1).EntireRow.Insert
End If
r = r - 1
Loop Until r = 1
End With
End Sub
Последнюю строку r определять в зависимости от данных на листе