Forum Discussion

Brass Contributor

Apr 16, 2018

Copy specific cell to new worksheet but keep original cell value

Trying to copy a specific cell(s) from sheet 1 to sheet 2 when a value in said cell changes. example: part 1. sheet1 cell B2 value=1 sheet1 cell E2 Value is 10 Copies value from sheet1 cell...

copy cell

Macros & VBA

Haytham Amairah

Silver Contributor

Apr 16, 2018

Hi,

The solution is powered by this code:

Sub test()
 On Error Resume Next
 Application.ScreenUpdating = False
 
 Dim r1, r2 As Integer
 
 r1 = Application.WorksheetFunction.CountA(Sh2.Range("B:B"))
 r2 = Application.WorksheetFunction.CountA(Sh2.Range("E:E"))
 
 Sh2.Range("B1").Offset(r1).Value = Sh1.Range("B2").Value
 Sh2.Range("E1").Offset(r2).Value = Sh1.Range("E2").Value
 Sh2.Activate
 Sh2.Range("E1").Offset(r2).Select
 
 Application.ScreenUpdating = True
 On Error GoTo 0
End Sub

This is the explanation of the code (line by line):

To prevent any error message from appearing

On Error Resume Next

To turn off the screen updates and flickers that can appear while the code is running

Application.ScreenUpdating = False

To count the numbers of the non-blanks cells in column B of the sheet 2 and assign it to the variable r1

r1 = Application.WorksheetFunction.CountA(Sh2.Range("B:B"))

To count the numbers of the non-blanks cells in column E of the sheet 2 and assign it to the variable r2

r2 = Application.WorksheetFunction.CountA(Sh2.Range("E:E"))

The below code sets the focus on the cell B1 of the Sheet 2, and go down (offset) by the number of the non-blanks cells in column B of the Sheet 2, and then it assigns the value of the cell B2 of the sheet 1 to the new cell in column B of the Sheet 2.
NOTE: The number the non-blanks cells is already assigned to the variable r1, so I passed this variable to the Offset function: Offset(r1).

Sh2.Range("B1").Offset(r1).Value = Sh1.Range("B2").Value

This is the same code above but for the column E of the Sheet 2

Sh2.Range("E1").Offset(r2).Value = Sh1.Range("E2").Value

To activate the Sheet 2

Sh2.Activate

To select the last filled cell in column E of the Sheet2 after the process is finished

NOTE: This code is bonus and you can delete it!

Sh2.Range("E1").Offset(r2).Select

These are the last two lines which are used to restore the default status of the screen updating and error handling

 Application.ScreenUpdating = True
 On Error GoTo 0

I hope this is clear enough

Haytham

Move_Specific_Cells_To_Another_Sheet.xls42 KB

hopr37 hotmail

Brass Contributor

Apr 16, 2018

Thank you so much. I figured out what I was doing wrong so I have the original formula working.

Sh2.Range

I had to change that to: Sheets("the name of my sheet").Range

Now I'll look over what you just posted and get back to you.
I really appreciate the help.

Is it simply to make a change so that ANY value that is changed in column B and column E would do the same?

Haytham Amairah
Silver Contributor
Apr 16, 2018
Do you mean that you want to get rid of using the button and make this code triggers in case if the cell B2 or E2 of the Sheet 1 is changed?

If so, please right-click the Sheet 1 tab and choose View Code, and then copy and paste this code there:
Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.ScreenUpdating = False

If Not Intersect(Target, Range("B2, E2")) Is Nothing Then

Dim r1, r2 As Integer

r1 = Application.WorksheetFunction.CountA(Sh2.Range("B:B"))
r2 = Application.WorksheetFunction.CountA(Sh2.Range("E:E"))

Sh2.Range("B1").Offset(r1).Value = Sh1.Range("B2").Value
Sh2.Range("E1").Offset(r2).Value = Sh1.Range("E2").Value
Sh2.Activate
Sh2.Range("E1").Offset(r2).Select

End If

Application.ScreenUpdating = True
On Error GoTo 0
End Sub
- hopr37 hotmail
  Brass Contributor
  Apr 16, 2018
  well I did remove the button and got it to work automatically and it works great!
  But how difficult would it be to make it so on any of the "B" columns it would do the same thing? Not just B2 and E2? So any time I change any value in columns "B" or "E" it would still work the same?
  basically do it's code no matter what cell in column "B" get's changed.
  - Haytham Amairah
    Silver Contributor
    Apr 17, 2018
    
    hopr37 hotmail wrote:
    well I did remove the button and got it to work automatically and it works great!
    But how difficult would it be to make it so on any of the "B" columns it would do the same thing? Not just B2 and E2? So any time I change any value in columns "B" or "E" it would still work the same?
    basically do it's code no matter what cell in column "B" get's changed.
    
    In this case, please test this code:
    Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.ScreenUpdating = False
    
    If Not Intersect(Target, Range("B:B, E:E")) Is Nothing Then
    
    Dim r1, r2 As Integer
    
    r1 = Application.WorksheetFunction.CountA(Sh2.Range("B:B"))
    r2 = Application.WorksheetFunction.CountA(Sh2.Range("E:E"))
    
    Sh2.Range("B1").Offset(r1).Value = Sh1.Range("B" & Target.Row).Value
    Sh2.Range("E1").Offset(r2).Value = Sh1.Range("E" & Target.Row).Value
    Sh2.Activate
    Sh2.Range("E1").Offset(r2).Select
    
    End If
    
    Application.ScreenUpdating = True
    On Error GoTo 0
    End Sub