Copy specific range of cells on a change event then paste to a new row in a another sheet

[lizpcon]

I hope someone can provide me with some help. I realize there are many variations on this question, but I am not finding an answer that suits my needs. My expertise with VBA is basically restricted to finding code in posts that does what I need. I am definitely a beginner when it comes to code.

Essentially I need to copy the first 8 cells in a row in one sheet (for example: A3:I3) when the word "Actuals" is entered into A3 from a drop down list. Then the copied data needs to be pasted to a another existing worksheet in the same workbook in the next available row. The data includes mostly values, but there is a formula in column H that creates a hyperlink out of the content in column G, friendly name in column I.

I am not stuck on the idea of having "Actuals" entered in column A as the trigger or change event and there will be times when a new copy/paste of the same data will need to be done more than once at a later date.

For further information, column B contains a serial number/productID number.

Thanks,

Lizpcon

 

[JoeMo]

Welcome to the Board. What's the name of the paste sheet and what column do you want the paste to begin in?

 

[lizpcon]

The paste sheet is called PubCostTracking. I would like the paste to begin at A2. Thanks for the quick reply!

 

[JoeMo]

The paste sheet is called PubCostTracking. I would like the paste to begin at A2. Thanks for the quick reply!

This goes into a worksheet module for the sheet your drop down list is on.
To install the code:
1. Right-click the worksheet you want to apply it to and choose 'View Code'. This will open the VBE window.
2. Copy the code below from your browser window and paste it into the white space in the VBE window.
3. Close the VBE window and Save the workbook. If you are using Excel 2007 or a later version do a SaveAs and save it as a macro-enabled workbook (.xlsm file extension).
4. Make sure you have enabled macros whenever you open the file or the code will not run.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nR As Long
Set Target = Target.Cells(1, 1)
If Not Intersect(Target, Range("A3")) Is Nothing Then
    If Target.Value = ("Actuals") Then
        nR = WorksheetFunction.Max(2, Sheets("PubCostTracking").Range("A" & Rows.Count).End(xlUp).Row + 1)
        Range("A3", "I3").Copy Destination:=Sheets("PubCostTracking").Range("A" & nR)
    End If
End If
    
End Sub

 

[lizpcon]

Thanks! I've tried the code, but when I select "Actuals" from the drop-down list, get a compile error: Amiguous name detected: Worksheet_Change.

I already have some code on that sheet that provides a timestamp in column v when data is entered in columns r through u -- hope that is not causing the problem. Is it okay to put your code below the code for the timestamp? When I did a solid line was created under the End Sub of the timestamp code.

Any suggestions?

Thanks,

P.S. should it be Worksheet.change ?

 

[lizpcon]

Is it giving me the error because I have two sets of code with the same beginning?

I removed the timestamp code and now it works, but only for row 3. I need it to work for any cell in column A when "Actuals" is selected. The copy should then paste in the next available row in the PubCostTracking sheet.

How would I apply code so that it ends up on the PubCostTracking sheet when the paste is done?

Thanks,

 

[JoeMo]

Is it giving me the error because I have two sets of code with the same beginning?

I removed the timestamp code and now it works, but only for row 3. I need it to work for any cell in column A when "Actuals" is selected. The copy should then paste in the next available row in the PubCostTracking sheet.

How would I apply code so that it ends up on the PubCostTracking sheet when the paste is done?

Thanks,

You can't have two worksheet_change modules in the same sheet. That's why the ambiguous name message. This will work for all of column A and if you want to provide details of the other worksheet_change that triggers a timestamp maybe it can be included in this.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nR As Long
Set Target = Target.Cells(1, 1)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
    If Target.Value = ("Actuals") Then
        nR = WorksheetFunction.Max(2, Sheets("PubCostTracking").Range("A" & Rows.Count).End(xlUp).Row + 1)
        Range(Target, Target.Offset(0, 9)).Copy Destination:=Sheets("PubCostTracking").Range("A" & nR)
    End If
End If
    
End Sub

 

[lizpcon]

Thanks Joe,

It now works anytime "Acutals" is selected from any cell in column A, but doesn't take me to the destination sheet. Is there also a way that some of the content can be copies as values, and some as is (formulas)?

liz

 

[JoeMo]

Thanks Joe,

It now works anytime "Acutals" is selected from any cell in column A, but doesn't take me to the destination sheet. Is there also a way that some of the content can be copies as values, and some as is (formulas)?

liz

If you want to be on the destination sheet after the code executes then add these lines before the End Sub line:
Application.ScreenUpdating = False
Sheets("PubCostTracking").select

The way it stands now, constants are copied as constants and formulas as formulas. Are you wanting to copy some of the formulas as values and some as formulas? If yes, you need to provide the specific columns for each.

 

[lizpcon]

Thanks again Joe, it now goes to the destination sheet after copying and pasting -- what code would I use to have the active cell on the destination sheet be in column K of the newly pasted row?

In terms of the constants that should remain constants are column A, B, C. The formulas that should change to values (or constants) are column D, E, F, G. The formulas that should remain formulas are H, I, J. (I think I've added a column to the equation since we started this.)

This is what the code looks like now.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim nR As Long
Set Target = Target.Cells(1, 1)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Value = ("Actuals") Then
nR = WorksheetFunction.Max(2, Sheets("PubCostTracking").Range("A" & Rows.Count).End(xlUp).Row + 1)
Range(Target, Target.Offset(0, 9)).Copy Destination:=Sheets("PubCostTracking").Range("A" & nR)
End If
End If
Application.ScreenUpdating = False
Sheets("PubCostTracking").Select

End Sub


I haven't had success including the timestamp code within the same VBE window -- this is what I had before adding the copy/paste code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("q:q")) Is Nothing Then
Target.Offset(0, 5) = Now
End If
If Not Intersect(Target, Range("r:r")) Is Nothing Then
Target.Offset(0, 4) = Now
End If
If Not Intersect(Target, Range("s:s")) Is Nothing Then
Target.Offset(0, 3) = Now
End If
If Not Intersect(Target, Range("t:t")) Is Nothing Then
Target.Offset(0, 2) = Now
End If
If Not Intersect(Target, Range("u:u")) Is Nothing Then
Target.Offset(0, 1) = Now
End If
End Sub

Thanks again for your help. Not only have you helped me solve my problem, you've taught me something!

L