VBA Copy paste a range after a special cell changes

1
votes

I'm trying to copy and paste the values of a range whenever a cell in A1 changes.

For example, if cell in A1 (is coming from a formula) changes to "2016.10", it look ups the same value in A2:A14, finds it and copies the range B12:E12 (are also coming from formulas) and paste them as values. Or, if A1 changes to "2016.11", then copy paste the values of B13:E13.

Is there a way to do this with VBA?

Please_see_the_Photo

Thanks in advanced.

External Data is coming from another Sheet

2
excelvbacopy-paste
yr thread is not too clear, but if I understand rigth why you don't use this formula for each cell (depend how many records) Be=IF($A3=$A$1;"yr formulas";"") – Fabrizio
Hi Fabrizio, thanks for your reply. the formulas in cells B3:E4 are calculating the data which is coming from External source. External Data is updated each week, and it shows values only for current calendar week (A1). My aim is to record the values of the past calendar weeks. – Toli

2 Answers

1
votes

Are you looking something like this?

Sub SelectiveCopyPaste()
Dim WB As Workbook, Data1 As Range, Data2 As Range, RowData As Long, i As Long, FilePath As String

FilePath = "C:\Program Files\Microsoft Office\Office\RS.xlsb"       'Add your own file path
Set WB = Workbooks.Add(FilePath)
Set Data1 = Range("A2:A14")                                         'Change this accordingly
'Change this accordingly
Set Data2 = WB.Worksheets("RS_Summary").Range("Set the range you want to copy here")            

RowData = Data1.Rows.Count

For i = 1 To RowData
    If Data(i, 1) = Cells(1, 1) Then
        Data2(i, 1).Copy Data1(i, 2)                               'Change this too
        Exit For
    End If
Next
End Sub
1
votes

Finally, I found the way to tackle this problem. Here is the code I use to help me:

Sub PasteValues()

Dim RowData As Long, i As Long

Set Data = Range("A2:A108")

RowData = Data.Rows.Count

For i = 1 To RowData

    If Data(i, 1) = Cells(1, 1) Then

    Range(Cells(i + 1, 2), Cells(i + 1, 16)).Copy
    Range(Cells(i + 1, 2), Cells(i + 1, 16)).PasteSpecial xlPasteValues, 

Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    End If
Next i
Application.CutCopyMode = False

End Sub