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
|