VBA excel копирует над ячейками при пересечении

Мне нужно, чтобы Excel скопировал определенный диапазон в строку, которая в данный момент выбрана.

Например, у меня есть такие данные: введите здесь описание изображения

И когда я выбираю A3, мне нужно, чтобы Excel автоматически копировал диапазон C2: F2 в C3: F3, например введите здесь описание изображения

И так далее... Если я выберу A4, мне нужно скопировать C3:F3 в C4:F4...

Пожалуйста, как это возможно?


excel copy select vba intersect
person romanzdk    schedule 07.07.2018    source источник
comment
Должен ли тогда F3 быть 60? И как интерсект задействован и что вы пробовали? Когда у вас есть событие изменения, вы можете использовать объект Target в сочетании с .Row, чтобы получить строку выше. У вас есть большой выбор, включая OFFSET & RESIZE, объединение значений .Row в диапазоне, например. F & target.Row -1 и т.д.....   -  person QHarr    schedule 07.07.2018
comment
@TinMan да, но я не знаю, как определить, в какой строке я сейчас нахожусь, и как установить, какой диапазон я хочу скопировать.   -  person romanzdk    schedule 07.07.2018
comment
@QHarr F3 - это формула (B3 * E3). Пересекаются, потому что я думал о Worksheet_SelectionChange, а там If range Intersect then, но я не знаю, как динамически определить эти диапазоны.   -  person romanzdk    schedule 07.07.2018

Ответы (1)


arrow_upward
1
arrow_downward

Для меня это больше похоже на автозаполнение. Вероятно, вам следует заполнить с C2:F2.

Диапазон.Автозаполнение

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Target.Row = 1 And Not Intersect(Target, Range("A2", Columns("A"))) Is Nothing Then
        With Target.Offset(-1).EntireRow.Range("C1:F1")
            .AutoFill Destination:=.Resize(2), Type:=xlFillDefault
        End With
    End If
End Sub

Диапазон.Копировать

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Target.Row = 1 And Not Intersect(Target, Range("A2", Columns("A"))) Is Nothing Then
        With Target.EntireRow.Range("C1:F1")
            .Offset(-1).Copy Destination:=.Cells
        End With
    End If
End Sub
person TinMan    schedule 07.07.2018