Copy specific cell to new worksheet but keep original cell value

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