[حل شده] درست کردن فرم های خام برای هر فرد

[mehrdad71]

سلام من یه لیست 180 نفری دارم که میخوام برا هر نفرشون یه فرم ثابت داشته باشم به اسم خودشون یعنی روی اکسل راست کلیک بشه و از Rename اسم فایل تغییر کنه
آیا راهی هست که اتوماتیک بسازم یا باید دونه دونه فرم رو کپی کنم و اسم طرف رو بذارم اسم فایل اکسلم
ممنون میشم راهنماییم کنید

[Amir Ghasemiyan]

سلام من یه لیست 180 نفری دارم که میخوام برا هر نفرشون یه فرم ثابت داشته باشم به اسم خودشون یعنی روی اکسل راست کلیک بشه و از rename اسم فایل تغییر کنه
آیا راهی هست که اتوماتیک بسازم یا باید دونه دونه فرم رو کپی کنم و اسم طرف رو بذارم اسم فایل اکسلم
ممنون میشم راهنماییم کنید

سلام دوست عزيز
كامل متوجه سوالتون نشدم ولي با vba حتما شدني هست.
لطفا بفرماييد منظورتون از فرم چيه؟ يك فايل اكسل؟
اگر پاسختون مثبته ميخواهيد يك فايل مشخص رو فقط با اسم هاي مختلف ذخيره كنيد؟

[mehrdad71]

سلام دوست عزيز
كامل متوجه سوالتون نشدم ولي با vba حتما شدني هست.
لطفا بفرماييد منظورتون از فرم چيه؟ يك فايل اكسل؟
اگر پاسختون مثبته ميخواهيد يك فايل مشخص رو فقط با اسم هاي مختلف ذخيره كنيد؟

یه فایل اکسل دارم و میخوام این فایل رو تبدیل کنم به 180 تا فایل و قبل از ذخیره کردن از شیت دوم نام و نام خانوادگی رو به ترتیب برداره وبگذاره به عنوان نام فایل و save as کنه و نهایتا 180 تا فایل داشته باشم که اسم هر فایلی نام و نام خانوادگی پرسنلم باشه

[Amir Ghasemiyan]

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

خدمت شما دوست عزيز:

Sub EI_Copy2NewFile()
For Each c In Sheet1.Range("A1").CurrentRegion
    Sheet2.Copy
    ActiveWorkbook.SaveAs c.Value & ".xlsx"
    ActiveWorkbook.Close
Next c
End Sub

دقت داشته باشيد كه اسم افراد در شيت 1 و در ستون A از سلول A1 به بعد نوشته شده باشد و فرم مورد نظر در شيت 2

اگر سوالي هست در خدمتم وگرنه لطف كنيد تاپيك رو حل شده كنيد

[mehrdad71]

امکانش هست فایل اکسل ضمیمه کنید؟
ممنون میشم
آخه هر کار میکنم ارور میده

[Amir Ghasemiyan]

امکانش هست فایل اکسل ضمیمه کنید؟
ممنون میشم
آخه هر کار میکنم ارور میده

بله حتما.

احتمالا اين خطايي كه ميده بخاطر اينه كه آي دي شيت هاتون درست نيست
لطفا يا فايل ضميمه كنيد يا عكس از خطا بگيريد بررسي كنم

[mehrdad71]

بله حتما.

احتمالا اين خطايي كه ميده بخاطر اينه كه آي دي شيت هاتون درست نيست
لطفا يا فايل ضميمه كنيد يا عكس از خطا بگيريد بررسي كنم

واقعا ممنونم مشکل اصلیم برطرف شد فقط فایلا رو میره تو مای داکیومنت میسازه چطور میتونم محل ذخیره رو ادس بدم
و اینکه توی هر فرم کد پر سنلی طرف هم که توی شیت اول باشه برداشته بشه و توی فایل خودش ذخیره بشه
واقعا ممنونم

[Amir Ghasemiyan]

واقعا ممنونم مشکل اصلیم برطرف شد فقط فایلا رو میره تو مای داکیومنت میسازه چطور میتونم محل ذخیره رو ادس بدم
و اینکه توی هر فرم کد پر سنلی طرف هم که توی شیت اول باشه برداشته بشه و توی فایل خودش ذخیره بشه
واقعا ممنونم

خواهش ميكنم
براي تغييرات اخيري كه گفتين از اين كد كمك بگيريد:

Sub EI_Copy2NewFile()
Curl = ActiveWorkbook.Path
For Each c In Sheet1.Range("A1").CurrentRegion
    Sheet2.Copy
    Range("A1") = c.Offset(, 1)
    ActiveWorkbook.SaveAs Curl & "\" & c.Value & ".xlsx"
    ActiveWorkbook.Close
Next c
End Sub

بجاي Curl ميتونين هر آدرسي كه دوست داريد بدين. من آدرس فايل رو دادم كه همونجا بريزه
براي كد پرسنلي هم اگر كدها رو درست كنار اسامي بنويسيد اين كدي كه تقديم كردم كد پرسنلي ها رو در سلول A1 فايل جديد درج ميكنه

[mehrdad71]

خواهش ميكنم
براي تغييرات اخيري كه گفتين از اين كد كمك بگيريد:

Sub EI_Copy2NewFile()
Curl = ActiveWorkbook.Path
For Each c In Sheet1.Range("A1").CurrentRegion
    Sheet2.Copy
    Range("A1") = c.Offset(, 1)
    ActiveWorkbook.SaveAs Curl & "\" & c.Value & ".xlsx"
    ActiveWorkbook.Close
Next c
End Sub

بجاي Curl ميتونين هر آدرسي كه دوست داريد بدين. من آدرس فايل رو دادم كه همونجا بريزه
براي كد پرسنلي هم اگر كدها رو درست كنار اسامي بنويسيد اين كدي كه تقديم كردم كد پرسنلي ها رو در سلول A1 فايل جديد درج ميكنه

آقای مهندس تموم مشکلام حل شد فقط یه مشکل هست
وقتی کد ران بشه برا کل سلول های شیت یک به اسم خودشون یه فایل میسازه
ولی من میخوام فقط برا ستون اول بسازه

[Amir Ghasemiyan]

آقای مهندس تموم مشکلام حل شد فقط یه مشکل هست
وقتی کد ران بشه برا کل سلول های شیت یک به اسم خودشون یه فایل میسازه
ولی من میخوام فقط برا ستون اول بسازه

بله درسته. میتونین کد رو اینطوری تغییر بدین:

Sub EI_Copy2NewFile()
Curl = ActiveWorkbook.Path
For Each c In Sheet1.Range("A1:A180")
    Sheet2.Copy
    Range("A1") = c.Offset(, 1)
    ActiveWorkbook.SaveAs Curl & "\" & c.Value & ".xlsx"
    ActiveWorkbook.Close
Next c
End Sub