Страницы: 1
RSS
Как добавить строку со значениями (формулами, ссылками) над или под активную строку?
 
Здравствуйте. Помогите!
ЭТО
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C5")) Is Nothing Then
Call дз
End If
End Sub
Sub дз()
Range("A6").Rows("1:1").EntireRow.Insert вставляет строку ниже нужной

End Sub
КОД КОТОРЫЙ НАХОДИТСЯ ЗДЕСЬ. ЧТО он делает, добавляет новую строку под строкой 6, при изменении значения в ячейке с количеством ( С5).
ЧТО НУЖНО: нужно чтобы строка добавлялась не прямой ссылкой как сейчас А6, а добавлялась после той строки или над той строкой, в которой сейчас ,ведется работа, т.е., если я сейчас работаю в строке пять, то подставлялась над илди под строку 5,а если я работаю в строке 7, то над 7 или под 7, причем, строка должна копировать все значения всех ячеек, в связи с тем, что там ссылки и  формулы, которые всегда будут одинаковы для каждой категории (Поставки товара, Товары),все значения привязаны к выпадающему списку, он работает, я его настроил, описание тоже заполняетс, цена и сумма тоже, количество в ручную проставляем.

Нужно только добавить строку со всеми формулами и ссылками, над или под ту строку которая была активна  
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Columns("C:C")) Is Nothing Then
        Call дз(Target)
    End If
End Sub
Sub дз(r As Range)
    r.EntireRow.Rows("1:1").Copy
    r.EntireRow.Rows("2:2").Insert 'вставляет строку ниже нужной
End Sub
 
Спасибо.

Еще другой вопрос, а можно очищать значения, чтобы формулы и ссылки остались, а значения стерлись или выделялась строка другим цветом, новая которая?
Изменено: vikttur - 08.06.2021 17:25:32
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Columns("C:C")) Is Nothing Then
        Call дз(Target)
    End If
End Sub
Sub дз(r As Range)
    Application.EnableEvents = False
    r.EntireRow.Rows("1:1").Copy
    r.EntireRow.Rows("2:2").Insert 'вставляет строку ниже нужной
    Application.CutCopyMode = False
    On Error Resume Next
    r.EntireRow.Rows("2:2").SpecialCells(xlCellTypeConstants, 23).ClearContents
    On Error GoTo 0
    r.EntireRow.Rows("2:2").Interior.Color = 65535
    Application.EnableEvents = True
End Sub
 
Спасибо. Все получилось!
Изменено: vikttur - 08.06.2021 18:36:34
 
МатросНаЗебре, Здравствуйте. Еще один вопрос. Подскажите, а можно внести в этот код изменения, чтобы после добавления строки кодом, в ячейке количество по умолчанию всегда было 1!  
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Columns("C:C")) Is Nothing Then
        Call дз(Target)
    End If
End Sub
Sub дз(r As Range)
    Application.EnableEvents = False
    r.EntireRow.Rows("1:1").Copy
    r.EntireRow.Rows("2:2").Insert 'вставляет строку ниже нужной
    Application.CutCopyMode = False
    On Error Resume Next
    r.EntireRow.Rows("2:2").SpecialCells(xlCellTypeConstants, 23).ClearContents
    On Error GoTo 0
    r.Cells(2, 1).Value = 1
    r.EntireRow.Rows("2:2").Interior.Color = 65535
    Application.EnableEvents = True
End Sub
 
МатросНаЗебре,Получилось, спасибо. Только ПОБЕД.
Страницы: 1
Наверх