Помогите пожалуйста с макросом: необходимо автоматизировыать копирование строк заданое количество раз (в столбце J) Нашел одну старую тему с похожей задачей, но не получается приспособить к своему файлу. Буду благодарен за подробное разъяснение и макрос
Помогите пожалуйста с макросом: необходимо автоматизировыать копирование строк заданое количество раз (в столбце J) Нашел одну старую тему с похожей задачей, но не получается приспособить к своему файлу. Буду благодарен за подробное разъяснение и макросAlexyaki
Sub InsRows() Dim lr&, i& Application.ScreenUpdating = False lr = Cells(Rows.Count, 10).End(xlUp).Row For i = lr To 2 Step -1 Rows(i + 1 & ":" & i + Cells(i, 10) - 1).Insert shift:=xlDown Range("A" & i).Resize(, 30).Copy Range("A" & i + 1).Resize(Cells(i, 10) - 1, 30) Next i Application.ScreenUpdating = True End Sub
[/vba]
Pelena, рано радовался. Один файл сделал нормально а на втором выдает ошибку в строке [vba]
Sub InsRows() Dim lr&, i& Application.ScreenUpdating = False lr = Cells(Rows.Count, 10).End(xlUp).Row For i = lr To 2 Step -1 Rows(i + 1 & ":" & i + Cells(i, 10) - 1).Insert shift:=xlDown Range("A" & i).Resize(, 30).Copy Range("A" & i + 1).Resize(Cells(i, 10) - 1, 30) Next i Application.ScreenUpdating = True End Sub
Ошибка вылезает если попадается строка со значением "1". # тэги проставил, но не совсем понял это надо было делать или нет. Я не разбираюсь в этом. Сори если что не так
Ошибка вылезает если попадается строка со значением "1". # тэги проставил, но не совсем понял это надо было делать или нет. Я не разбираюсь в этом. Сори если что не такAlexyaki
Сообщение отредактировал Alexyaki - Четверг, 11.05.2017, 11:42
Sub InsRows() Dim lr&, i& Application.ScreenUpdating = False lr = Cells(Rows.Count, 10).End(xlUp).Row For i = lr To 2 Step -1 If Cells(i, 10) > 1 Then Rows(i + 1 & ":" & i + Cells(i, 10) - 1).Insert shift:=xlDown Range("A" & i).Resize(, 30).Copy Range("A" & i + 1).Resize(Cells(i, 10) - 1, 30) End If Next i Application.ScreenUpdating = True End Sub
[/vba]
Проверьте так [vba]
Код
Sub InsRows() Dim lr&, i& Application.ScreenUpdating = False lr = Cells(Rows.Count, 10).End(xlUp).Row For i = lr To 2 Step -1 If Cells(i, 10) > 1 Then Rows(i + 1 & ":" & i + Cells(i, 10) - 1).Insert shift:=xlDown Range("A" & i).Resize(, 30).Copy Range("A" & i + 1).Resize(Cells(i, 10) - 1, 30) End If Next i Application.ScreenUpdating = True End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
