range یک محدوه با کلیک

[khorasan66]

فایلی دارای دو شیت می باشد
هر سلول از شیت دوم که در حال انتخاب باشد به عنوان مثال سلول g10 ناحیه b10:m10 کپی شده و در آخرین ردیف شیت اول جایگزین شود .

توضیحات بیشتر :
کاربر با filter کردن یک سلول را انتخاب می نماید . سپس با اجرای ماژول می بایست اطلاعات درج شده در آن ردیف (?b?:m)را به انتهای شیت اول منتقل نماید

[Amir Ghasemiyan]

فایلی دارای دو شیت می باشد
هر سلول از شیت دوم که در حال انتخاب باشد به عنوان مثال سلول g10 ناحیه b10:m10 کپی شده و در آخرین ردیف شیت اول جایگزین شود .

توضیحات بیشتر :
کاربر با filter کردن یک سلول را انتخاب می نماید . سپس با اجرای ماژول می بایست اطلاعات درج شده در آن ردیف (?b?:m)را به انتهای شیت اول منتقل نماید

سلام
دوست عزيز اين رو تو بخش كد نويسي شيت اول قرار بدين. روي شيت راست كليك كنيد و گزينه view code رو بزنين


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
L = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
R = Range(Target.Address).Row
Range("B" & R & ":M" & R).Copy Destination:=Sheet2.Range("A" & L + 1)
End Sub



اين كد رو به كمك استاد اسماعيلي عزيز نوشتم. سعي شده كوتاه، ساده و سريع باشه

[khorasan66]

با سلام و تشکر دستور فوق را انجام دادم و صحیح بود
با توجه به اینکه هر کلیکی که در صفحه انجام شود ماژول اجرا می شود ،باعث بروز خطاهای متعدد می گردد لذا خواهشمند است :
دستور به گونه ای باشد که کاربر پس از انتخاب سلول ، خودش بتواند ماژول را اجرا نماید .
با تشکر فراوان از تمامی دوستان و اساتید ارجمند.

[Amir Ghasemiyan]

با سلام و تشکر دستور فوق را انجام دادم و صحیح بود
با توجه به اینکه هر کلیکی که در صفحه انجام شود ماژول اجرا می شود ،باعث بروز خطاهای متعدد می گردد لذا خواهشمند است :
دستور به گونه ای باشد که کاربر پس از انتخاب سلول ، خودش بتواند ماژول را اجرا نماید .
با تشکر فراوان از تمامی دوستان و اساتید ارجمند.

ميخواستم اين رو بهتون هشدار بدم ولي يادم رفت. بله اينطوري سرعت برنامه به شدت افت پيدا ميكنه
خب من كد رو براتون اصلاح كردم. اين رو داخل يك ماژول قرار بدين و يك دكمه تعريف كنيد كه اين ماژول رو فراخواني كنه


Sub sabt()
target = ActiveCell.Address
L = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
R = Range(target).Row
Range("B" & R & ":M" & R).Copy Destination:=Sheet2.Range("A" & L + 1)
End Sub

[khorasan66]

ضمن تشکر از شما ، خودم هم با کد زیر به یک نتیجه مطلوبی رسیدم البته خیلی ماهرانه نیست :
Sheet1.Range(Sheet1.Range("A2").End(xlDown).Offset(1, 0), Sheet1.Range("A2").End(xlDown).Offset(1, 8)) = Sheet2.Range("B" & (ActiveCell.Row) & ":J" & (ActiveCell.Row)).Value

[majid_mx4]

با سلام

ضمن تشکر از دوست خوبم جناب آقای قاسمیان و کسب اجازه از ایشان

با مقداری تغییر در کد ایشان مشکل کپی شدن داده های ناخواسته حل میشود.

در دستور زیر در صورتیکه در هر یک از خانه های ستون A کلیک کنید مقدار مربوطه در شیت دو کپی میشود و برای جابجایی و حرکت میتوانید از دیگر ستونها استفاده نمایید.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

mm = Split(Target.Address, "$")(1)
If mm <> "A" Then
Exit Sub
Else
L = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
R = Range(Target.Address).Row


Range("B" & R & ":M" & R).Copy Destination:=Sheet2.Range("A" & L + 1)
End If
End Sub
با تشکر میر