[حل شده] کپی شیت و تعییر نام به کمک vba

[Z.Ruzbeh]

با عرض سلام و خسته نباشید
ورک بوک من 2 عدد شیت داره به نام های"بانک "و" 1"
در شیت بانک ستونی دارم به نام شماره شیت که از 1 شروع میشود و در هر ردیف یکی به آن اضافه میشود
حالا میخوام با اجرای یک کد vba از شیت 1 کپی تهیه کرده و بعد از آن شیت های جدیدی با شماره 2 و بهمین ترتیب 3 و 4 و5 ایجاد گردد
به گونه ای که شیت های من دارای شماره 1 تا عدد دلخواه بصورت سری ایجاد شود
سلول های هر شیت با برداشتن شماره شیت و دستور vlookup مقادیر را از بانک جایگذاری میکنند . بهمین دلیل ایجاد شیت بصورت دستی و تغییر اسم ان زمان بر است . در بانک ستونی جهت شیت مورد نظر ایجاد کردم
پیشاپیش از همکاری شما متشکرم

[hadi1980]

سلام
اگه ممکنه فايل بزاريد و البته اين برنامه هم ميتونه کمکتون کنه

[حسام بحرانی]

با عرض سلام و خسته نباشید
ورک بوک من 2 عدد شیت داره به نام های"بانک "و" 1"
در شیت بانک ستونی دارم به نام شماره شیت که از 1 شروع میشود و در هر ردیف یکی به آن اضافه میشود
حالا میخوام با اجرای یک کد vba از شیت 1 کپی تهیه کرده و بعد از آن شیت های جدیدی با شماره 2 و بهمین ترتیب 3 و 4 و5 ایجاد گردد
به گونه ای که شیت های من دارای شماره 1 تا عدد دلخواه بصورت سری ایجاد شود
سلول های هر شیت با برداشتن شماره شیت و دستور vlookup مقادیر را از بانک جایگذاری میکنند . بهمین دلیل ایجاد شیت بصورت دستی و تغییر اسم ان زمان بر است . در بانک ستونی جهت شیت مورد نظر ایجاد کردم
پیشاپیش از همکاری شما متشکرم

سلام دوست عزیز
به انجمن خوش آمدید.

از این کد کمک بگیرید:

Sub CopySheet()
Dim ws1 As Worksheet
Set ws1 = Worksheets("1")
ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
ActiveSheet.Name = Application.Sheets.Count - 1
End Sub 

موفق باشید.

[Z.Ruzbeh]

سلام
اگه ممکنه فايل بزاريد و البته اين برنامه هم ميتونه کمکتون کنه

با تشکر از توجه و پاسخ شما
به پیوست فایل مذکور ارسال می گردد

- - - Updated - - -

سلام دوست عزیز
به انجمن خوش آمدید.

از این کد کمک بگیرید:

Sub CopySheet()
Dim ws1 As Worksheet
Set ws1 = Worksheets("1")
ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
ActiveSheet.Name = Application.Sheets.Count - 1
End Sub 

موفق باشید.

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

[حسام بحرانی]

سلام ، خواهش می کنم.

مطمئن نیستم منظورتون رو درست متوجه شده باشم! با این حال لطفاً کد زیر رو تست کنید:

Sub CopySheet()
Dim ws1 As Worksheet
Set ws1 = Worksheets("1")
ws1.Copy after:=ThisWorkbook.Sheets(Sheets.Count)
ActiveSheet.Name = Application.Sheets.Count - 1
End Sub 

موفق باشید.

[Z.Ruzbeh]

سلام ، خواهش می کنم.

مطمئن نیستم منظورتون رو درست متوجه شده باشم! با این حال لطفاً کد زیر رو تست کنید:

Sub CopySheet()
Dim ws1 As Worksheet
Set ws1 = Worksheets("1")
ws1.Copy after:=ThisWorkbook.Sheets(Sheets.Count)
ActiveSheet.Name = Application.Sheets.Count - 1
End Sub 

موفق باشید.

من میخوام آخرین شماره شیت رو بیاد کپی کنه
فرض کنید ماکرو را ران کردیم و از شیت شماره 1 کپی با نام شیت 2 ایجاد گردید . حال باید بعد از اجرا مجدد ماکرو از شیت شمار 2 کپی تهیه شود و شیت شماره 3 ایجاد شود بصورتی که بعد از شیت دوم در آخر لیست قرار بگیرد بعد از اصلاح کد الان شیت های جدید رو به انتهای شیت ها اضافه میکند ولی ماکرو شیت 1 را فقط کپی میکند در حالیکه میخوایم اخرین شیت کپی شود

[حسام بحرانی]

ActiveSheet.Copy

راحت ترین کار اینه که کدتون رو به اینصورت تغییر بدید:

Sub CopySheet()
Dim ws1 As Worksheet
Set ws1 = Worksheets("1")
ActiveSheet.Copy after:=ThisWorkbook.Sheets(Sheets.Count)
ActiveSheet.Name = Application.Sheets.Count - 1
End Sub 

( البته این راحت ترین کاره و در واقع می بایست در آخرین شیت تولید شده قرار داشته باشید! ببینید خودتون می تونید راه حل اصلی رو پیدا کنید؟! و یا اینکه همین کد کار شما را راه میندازه )
موفق باشید.