Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

Dim test As String
Dim strSngCell As String
Dim strCellAddress As String
   
   
 'MsgBox ("test")
strCellAddress = Target.Cells.Address

If Target.Cells.Value <> "" Then

   strSngCell = Replace(strCellAddress, "$", "")

    Range(strSngCell & ":" & strSngCell).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range(strSngCell).Select
   
    ActiveSheet.Paste

 
End If

End Sub