автоматическое протягивание строк и формул

[IFRSoff]

Всем привет!
У меня есть вопрос, давно мучающий меня. Очень хочется получить ответ. Вопрос сформулирован в файле.

[Marchuk]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column < 3 Then
    Range("E" & Target.Row).FormulaR1C1 = "=RC[-4]"
    Range("F" & Target.Row).FormulaR1C1 = "=RC[-4]"
    Range("G" & Target.Row).FormulaR1C1 = "=RC[-4]"
End If
End Sub

вставь в код листа

[IFRSoff]

Спасибо. Но в данном коде необходимо активировать каждую ячейку. А можно как-нибудь обойти это, чтобы при вставке таблицы, все заполнилось? Способ хороший, но подходит, если таблица заполняется вручную.

[SAS888]

Может быть я опять что-то не так понял? Требуется, чтобы при вставке (удалении, очистки и т.п.) данных в столбцы "A:C" (хоть вручную, хоть копи/паст), эти же данные появлялись (удалялись) и в столбцах "E:G", с прорисовкой границ. Так? Если так, то вставьте в модуль нужного листа код:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim r As Long, Lr As Long
    If Target.Column < 4 Then
        Application.EnableEvents = False
        r = Cells(Rows.Count, "A").End(xlUp).Row: Lr = Cells.SpecialCells(xlCellTypeLastCell).Row
        Range([A2], Cells(Lr, "C")).Copy [E2]: Range(Cells(r + 1, "A"), Cells(Lr, "G")).Delete Shift:=xlUp
        With Union(Range([A2], Cells(r, "C")), Range([E2], Cells(r, "G")))
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlInsideVertical).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        End With
        Application.EnableEvents = True
    End If

End Sub

[IFRSoff]

Еще раз спасибо, но....
Наверное у меня пример неудачный Похоже. Я когда вставил код, то подумал, что то что надо. Надо посмотрев поближе понял, что все же не то. Это в примере формулы простые, которые выглядят, как дублирование данных, на самом деле они могт быть иными. Например умножающими вставленные данные на количество месяцев. Поэтому, я и хочу заполнять формулами, только первую строку таблицы, если же эти формулы, возвращают значение какое-либо, в данном примере эти значения указаны в условном форматировании, то формула копируется на строку ниже. В итоге, при включенном макросе в данном примере, в таблице последняя строка таблицы будет заполена формулами, которые возвратят нули. Что и будет концом цикла.

[SAS888]

Т.е. при заполнении столбцов "A:C", в столбцах "E:G" существующая формула должна "протягиваться" (а при удалении убираться) на соответствующее вставленным количеству строк?

[SAS888]

Если так, то может быть это подойдет:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim r As Long, Lr As Long
    If Target.Column < 4 Then
        Application.EnableEvents = False
        r = Cells(Rows.Count, "A").End(xlUp).Row: Lr = Cells.SpecialCells(xlCellTypeLastCell).Row
        [E2:G2].AutoFill Destination:=Range([E2], Cells(Lr, "G")), Type:=xlFillDefault
        Range(Cells(r + 1, "A"), Cells(Lr, "G")).Delete Shift:=xlUp
        Application.EnableEvents = True
    End If

End Sub

[IFRSoff]

Спасибо! То, что надо. Осталось только разобраться, как изменять целевые диапазоны и задавать ячейки для копирования, чтобы подгонять код под мои таблицы.