Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » pro_sys
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
Добавление строк при нажатие на кнопку, С копированием формул по условию
 
#
15.02.2018 19:26:53
Господа прошу помочь с макросом для автоматического добавления 10 строк при нажатие на кнопку с копированием формул по условию.
На данный момент почти отладил его работу, но встрял на следующем:
1. При первом нажатие добавляется 10-ть строк, а при повторном - всего одна.
2. Новые строки появляются после максимального значения в столбце А, но мне нужно, что бы они добавлялись после последней ячейке таблицы и не важно заполнена она или нет... и вот здесь я совсем встрял...
Код
Sub ADD()
Application.ScreenUpdating = False
    
    Dim wsheet As Worksheet
    Dim iLastrow As Integer
    Dim m As Integer, i As Integer, strNum1 As Integer

                    With ThisWorkbook.Worksheets("Ввод")
                                iLastrow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                                m = Application.WorksheetFunction.Max(Range("a21:a" & iLastrow))
                                   For i = iLastrow To 1 Step -10
                                         If Cells(i, 1) = m Then
                                            If strNum1 = 0 Then
                                                strNum1 = i
                                                Rows(strNum1 + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                                                Range(Cells(strNum1, 1), Cells(strNum1, 25)).AutoFill Destination:=Range(Cells(strNum1, 1), Cells(strNum1 + 10, 25)), Type:=xlFillDefault
                                                Range(Cells(strNum1 + 1, 1), Cells(strNum1 + 10, 6)).ClearContents
                                                Range(Cells(strNum1 + 1, 11), Cells(strNum1 + 10, 11)).ClearContents
                                                Range(Cells(strNum1 + 1, 15), Cells(strNum1 + 10, 18)).ClearContents
                                    
                                    Exit For
      
                                             End If
                                            End If
                                 Next i
                    End With
                            

    Application.ScreenUpdating = True
End Sub
 
Перейти    
Запуск макроса на нескольких листах при нажатие на кнопку, условия копирования данных на листах разные
 
#
01.02.2018 18:34:46
Добрый день форумчане)

Не силен в макросах и наверное поэтому ломаю уже второй день голову...
Собственно задача следующая: при нажатие на кнопку должен запускать макрос, который добавляет на:
1. на Листе "Ввод" после последней ячейки таблицы 10-ть строк с условием, что некотрые из этих ячеек, которые располагаются в определенных столбцах будут очищены от данных, а остальные нет.
2. на Листе "Проверка" должны так же добавляться после последней ячейки аналогичной таблицы 10-ть строк, но уже без условий по очистке данных.
Доп. уточнение: названия и количество столбцов на листах полностью совпадает, как и начало таблиц расположенных на них.

На данным момент мне удалось реализовать ввод 10-ти строк на рабочем листе "Ввод" после максимально найденного значения в диапазоне и задать условия по очистке данных в определенных столбцах. Собственно остались такие вопросы:

1. Как реализовать выполнение макроса "добавления строк в таблицу" на НЕСКОЛЬКИХ ЛИСТАХ при нажатие одной кнопки, так что бы на листе "Ввод" были условия по копированию данных из строк выше, а на листе "Проверка" их не было
2. Как сделать добавление строк после ПОСЛЕДНЕЙ ячейки таблицы, а не ячейки содержащей максимальное значение...

Код
Sub ADD()
Application.ScreenUpdating = False
    Dim iLastrow As Integer
    Dim m As Integer, i As Integer, strNum1 As Integer, strNum2 As Integer

    iLastrow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    m = Application.WorksheetFunction.Max(Range("a1:a" & iLastrow))


    For i = 1 To iLastrow
        If Cells(i, 1) = m Then
            If strNum1 = 0 Then
                strNum1 = i
                Rows(strNum1 + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Range(Cells(strNum1, 1), Cells(strNum1, 25)).AutoFill Destination:=Range(Cells(strNum1, 1), Cells(strNum1 + 10, 25)), Type:=xlFillDefault
                Range(Cells(strNum1 + 1, 1), Cells(strNum1 + 10, 6)).ClearContents
                Range(Cells(strNum1 + 1, 11), Cells(strNum1 + 10, 11)).ClearContents
                Range(Cells(strNum1 + 1, 15), Cells(strNum1 + 10, 18)).ClearContents

        
                Exit For
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
Изменено: pro_sys - 02.02.2018 16:28:25
 
Перейти    
Страницы: 1
Наверх