[حل شده] وقتي روي يك عنوان كليك كنم روي يك سلول خاص كپي بشه

[fozoolbashi]

با سلام
يه گزارش ساختم كه داراي 5 شيت به شكل نمونه پيوست example
توي گزارشم مديرم از من ميخواست كه با دبل كليك كردن بر بروي b17 الي b52 در شيت "خلاصه حساب" همون سلول b كپي بشه در شيت "repourt" در سلول a1 كه با كمك دوستان ماكرو زيرو براي اين كار نوشتيم.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, Range("b17:b58")) Is Nothing Then
    Cancel = True
    If Target.Row > 1 And Len(Target.Value) Then Worksheets("report").Range("a1").Value = Target.Value
    Worksheets("report").Activate
    End If
End Sub 

حالا مديرم از من ميخواد كه همين كار بالا توي اين اكسل باشه اما يه قابليت جديدم بهش اضافه بشه مثل اگه در شيش "خلاصه حساب" اگه از j17 الي j52 دبل كليك بكنه سلول b17 الي b52 كپي بشه در شيت "report-ago" در سلول a1
به عنوان مثال اگه دبل كليك كرد رو j18 اتوماتيك وار محتويات سلول b18 رو كپي كنه در شيت "report-ago" در سلول a1
اميدوارم تونسته باشم درست سوالمو مطرح كرده باشم
ممنون ميشم راهنماييم كنيد

[fozoolbashi]

فكر كنم سوال سختي كرده باشم

[M_ExceL]

با سلام
يه گزارش ساختم كه داراي 5 شيت به شكل نمونه پيوست example
توي گزارشم مديرم از من ميخواست كه با دبل كليك كردن بر بروي b17 الي b52 در شيت "خلاصه حساب" همون سلول b كپي بشه در شيت "repourt" در سلول a1 كه با كمك دوستان ماكرو زيرو براي اين كار نوشتيم.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, Range("b17:b58")) Is Nothing Then
    Cancel = True
    If Target.Row > 1 And Len(Target.Value) Then Worksheets("report").Range("a1").Value = Target.Value
    Worksheets("report").Activate
    End If
End Sub 

حالا مديرم از من ميخواد كه همين كار بالا توي اين اكسل باشه اما يه قابليت جديدم بهش اضافه بشه مثل اگه در شيش "خلاصه حساب" اگه از j17 الي j52 دبل كليك بكنه سلول b17 الي b52 كپي بشه در شيت "report-ago" در سلول a1
به عنوان مثال اگه دبل كليك كرد رو j18 اتوماتيك وار محتويات سلول b18 رو كپي كنه در شيت "report-ago" در سلول a1
اميدوارم تونسته باشم درست سوالمو مطرح كرده باشم
ممنون ميشم راهنماييم كنيد

با سلام،
کد زیر را جایگزین کنید :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 2 And Target <> Empty And IsNumeric(Target.Value) Then
    Worksheets("report").Range("a1").Value = Target.Value
    Worksheets("report").Activate
ElseIf Target.Column = 10 And Target <> Empty And IsNumeric(Target.Value) Then
    Worksheets("report-ago").Range("a1").Value = Target.Offset(, -8).Value
    Worksheets("report-ago").Activate
End If
End Sub

[fozoolbashi]

خيلي خيلي متشكر بسيار عالي و كاربردي