Когда значение ячейки изменяется, скопируйте столбец, из которого значение ячейки изменилось, на другой лист в том же диапазоне - PullRequest
0 голосов
/ 05 июня 2019

Например, если в диапазоне A: изменить только ячейку A8, скопируйте D4: D8 и вставьте его в качестве значения в лист "ADP" в то же место, т.е. D4: D8.

Для этогоЯ пробовал следующий макрос

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.range = "A:A" Then
        Call copy_paste_as_value
    End If
End Sub


Sub copy_paste_as_value()
    Range("d4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    Sheets("ADP").Activate
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C4").Select
    Application.CutCopyMode = False
End Sub

Я хочу скопировать только те данные, для которых изменяется значение ячейки, но он копирует всю таблицу на другой лист.

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

здесь следует отметить, что данные следует копировать только при наличии изменений в диапазоне A: A, если изменение в любомдругие ячейки, кроме копирования, не требуются.

любая помощь будет оценена.спасибо.

Ответы [ 2 ]

2 голосов
/ 05 июня 2019

Предполагая, что относительный диапазон соответствует, попробуйте это

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r As Range

If Target.Column = 1 And Target.Row > 4 Then
    Set r = Target.Offset(-4, 3).Resize(5)
    Worksheets("ADP").Range(r.Address).Value = r.Value
End If

End Sub
1 голос
/ 05 июня 2019

Вы можете попробовать:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim wsSou As Worksheet, wsDes As Worksheet

    'Set the worksheets to avoid conflicts
    Set wsSou = Target.Worksheet
    Set wsDes = ThisWorkbook.Worksheets("ADP")

    If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then

        wsDes.Range(wsDes.Cells(Target.Row, 4), wsDes.Cells(Target.Row, 9)).Value = wsSou.Range(wsSou.Cells(Target.Row, 4), wsSou.Cells(Target.Row, 9)).Value

    End If

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...