[حل شده] کپی کردن از یک باتوم دارای کد و پیست در همان شیت و مشکل در اختصاص کد خاص برای متغییر های مختلف

[bnyamin]

با سلام
در پاسخی که یکی از دوستان ارسال کرده بودند بنده با یک مشکل مواجه شدم !!!
پاسخ این است

Sub M_ExceL()
Dim A() As StringDim M As VariantDim r, i, lstr As Long
ActiveSheet.AutoFilterMode = False
lstr = Cells(Rows.Count, 1).End(3).Row
M = Array("(#)", "(##)", "(###)", "#-", "#)-")
r = 1For i = 1 To lstr    For Each itm In M        If Left(Cells(i, 1), 6) Like "*" & itm & "*" _        And Len(Cells(i, 1)) > 5 Then            ReDim Preserve A(1 To r)            A(r) = Cells(i, 1)            r = r + 1        End If    NextNext
Range("a1:a" & lstr).AutoFilterRange("a1:a" & lstr).AutoFilter Field:=1, Criteria1:=A, _Operator:=xlFilterValuesEnd Sub 

این پاسخ کاملا برای بنده مفید است ولی میخواهم در چند باتوم دیگر مقادیر m را تغییر دهم

تغییر در m که فرموده بودید
من برای اینکه از m تغییر بدهم و دارای مقادیر مختلف بکنم برای باتوم های مختتلف
1- مقدمتا از باتوم یک کپی گرفته و پیست میکنم
و در دیویلوپر وارد بخش کد میشم و قسمت m را متعاقبا نیاز خودم تعریف میکنم
در نتیجه ؛متاثر از مقادیر مختلف m چندین باتوم را ایجاد میکنم


حال موضوع اینجاست با توجه به اینکه من باتوم ها رو بعد از پیست تغییر نام میدهم ولی وقتی که یک باتوم را تغییر کد میدهم این تغییر در همه باتومهام اعمال میشه !!!


چگونه میتونیم یک باتوم را کپی و پیست کنیم و متعاقبا هر باتوم را اختصاصا تغییر کد دهیم و در همون شیت پیست کنم ؟!!


فایل پیوست زحمتی است که جناب M_ExceL مطرح کرده بودند !!!

[M_ExceL]

سلام،
شما می بایست از سابروتینی که بنده ایجاد کرده ام کپی بگیرید و داخل همون ماژول و زیر سابروتین قبلی پیست کنید
سپس نام ساب رو تغییر بدید به اسم دلخواه خودتون و اون رو به باتنی که مد نظرتون هست تخصیص بدید
اکنون می تونید داخل سابروتین جدید کدها رو در صورت نیاز و برای خواسته خودتون تغییر بدید
جهت اختصاص ساب به باتن، روی باتن مورد نظر راست کلیک کنید و گزینه Assing macro را انتخاب کنید
مثال زیر رو ببینید :

Sub M_ExceL()

    MsgBox "sub 1"
    
End Sub


Sub M_ExceL2()

    MsgBox "sub 2"
    
End Sub