CODEWITHSUNDEEP
excelvbaexcel-2010
Arshit patel
Arshit patel

Reputation: 133

When a cell value changes, copy the column from where the cell value changed to another sheet at the same range

For example, if in the range of A:A only cell A8 change then copy D4:D8 and paste it as value in sheet "ADP" at the same place i.e. D4:D8.

For that I have tried the following macro

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

I want to copy only that data against which cell value changes, but it copies the whole table to another sheet.

main issue for me is to figure out which cell changed and copy data from that column only from which cell value changed.

here, it's to be noted that data should be copied only if there is change in range A:A, if change in any other cell than copy paste not required.

any help will be appriciated. thank you.

Upvotes: 0

Views: 1722

Answers (2)

Error 1004
Error 1004

Reputation: 8240

You could try:

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

Upvotes: 1

SJR
SJR

Reputation: 23081

Assuming the relative range is consistent, try this

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

Upvotes: 2

Related Questions