ایجاد یک فایل اکسل جداگانه با چند شیت خاص از فایل اصلی جهت گزارش گیری

[amin.t]

سلام بر دوستان و اساتید عزیز
من یه فایل اکسل دارم می خواستم بدونم چطور با کد نویسی چند شیت خاص اونرو در یک workbook جدید (در یک فایل اکسل جدید ) استخراج بکنم و اونرو در مسیر فایل اصلی با اسمی که در یک سل خاص مثلا سل a1 وجود داره ذخیره بکنه؟
ممنون میشم که راهنمایی بفرمایید

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.

[Ali Parsaei]

سلام،
فرض کنيم فايلي داريد با دو شيت 1 و 2
ماکرو زير شيت دوم فايل را به نام چيزي که در خانه A1 شيت يک نوشته ايد در مسير همين فايل ذخيره مي کند (با فرمت XLSX):

Sub Macro1()
Dim c As String
c = Sheets("sheet1").Range("a1").Value
Sheets("Sheet2").Select
Sheets("Sheet2").Copy
ActiveWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path & "\" & c & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
End Sub

[amin.t]

سلام،
فرض کنيم فايلي داريد با دو شيت 1 و 2
ماکرو زير شيت دوم فايل را به نام چيزي که در خانه A1 شيت يک نوشته ايد در مسير همين فايل ذخيره مي کند (با فرمت XLSX):

Sub Macro1()
Dim c As String
c = Sheets("sheet1").Range("a1").Value
Sheets("Sheet2").Select
Sheets("Sheet2").Copy
ActiveWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path & "\" & c & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
End Sub

سلام آقا علی یه دنیا ممنونم عالی بود
یه سئوال دیگه داشتم .اگر بخوام فایلی که بازه بطور کامل همراه با ماکروهاش رو در یک فایل جدید ایجاد کنم (البته با ماکرو نویسی ) چطور این کارو کنم ؟

[Ali Parsaei]

يعني فايل فعال عينا" يک کپي ازش تهيه بشود؟
اون وقت بايد يک فکري هم براي نام فايل جديد نمود وگرنه با انجام چند باره ماکرو مورد نظر، هر دفعه که کپي مي گيريد روي کپي قبلي SAVE مي شود! يا اينکه مهم نيست؟
با اين حساب من اين کد را پيشنهاد مي کنم که در آن تاريخ روز کپي گيري از فايل اصلي به اول نام فايل اضافه شده و از آن يک کپي تهيه مي شود:

Sub Macro1()
Dim C As Variant
Dim D As Variant
D = Format(Date, " YY-MM-DD ")
C = ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path & "\" & D & C
End Sub

[amin.t]

يعني فايل فعال عينا" يک کپي ازش تهيه بشود؟
اون وقت بايد يک فکري هم براي نام فايل جديد نمود وگرنه با انجام چند باره ماکرو مورد نظر، هر دفعه که کپي مي گيريد روي کپي قبلي SAVE مي شود! يا اينکه مهم نيست؟
با اين حساب من اين کد را پيشنهاد مي کنم که در آن تاريخ روز کپي گيري از فايل اصلي به اول نام فايل اضافه شده و از آن يک کپي تهيه مي شود:

Sub Macro1()
Dim C As Variant
Dim D As Variant
D = Format(Date, " YY-MM-DD ")
C = ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path & "\" & D & C
End Sub

سلانم آقا علی ممنون از راهنمایتون
ولی من می خوام فایل اصلیم زمانی که فایل دوم ایجاد می شه بسته نشه .و فایل دوم اسمش براساس سلb2 سیو شود.

[Ali Parsaei]

فرض کنيم نام فايل اصلي شما ASL باشد و نام شيتي که خانه B2 آن جهت تعيين اسم مد نظر است SHEET1 باشد، اون وقت کدش اينجوري مي شود:

Sub Macro1()
Dim c As Variant
c = Sheets("sheet1").Range("b2").Value & ".xlsm"
ActiveWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path & "\" & c
Workbooks.Open Filename:=ThisWorkbook.Path & "/asl.xlsm"
Workbooks("asl").Activate
Workbooks(c).Close
End Sub

امتحان کنيد ببينيد درست کار مي کند؟

[amin.t]

سلام،
فرض کنيم فايلي داريد با دو شيت 1 و 2
ماکرو زير شيت دوم فايل را به نام چيزي که در خانه A1 شيت يک نوشته ايد در مسير همين فايل ذخيره مي کند (با فرمت XLSX):

Sub Macro1()
Dim c As String
c = Sheets("sheet1").Range("a1").Value
Sheets("Sheet2").Select
Sheets("Sheet2").Copy
ActiveWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path & "\" & c & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
End Sub

سلام
آقا علی من فایلی که استخراج می کنم را با پسوند .xls برای اکسل 2003 تهیه می کنم .
فالهای استخراج شده بعد از باز کردن چندتا ارور می ده درباره قابلیت هایی که پس از سیو شدن با ورژن پایین از دست رفته اند .یکیش قابلیت نام هایی که برای سلول هام تعریف کردم .
حالا چطور این مشکل رو بر طرف کنم ؟

[amin.t]

سلام
آقا علی من فایلی که استخراج می کنم را با پسوند .xls برای اکسل 2003 تهیه می کنم .
فالهای استخراج شده بعد از باز کردن چندتا ارور می ده درباره قابلیت هایی که پس از سیو شدن با ورژن پایین از دست رفته اند .یکیش قابلیت نام هایی که برای سلول هام تعریف کردم .
حالا چطور این مشکل رو بر طرف کنم ؟

فرض کنيم نام فايل اصلي شما ASL باشد و نام شيتي که خانه B2 آن جهت تعيين اسم مد نظر است SHEET1 باشد، اون وقت کدش اينجوري مي شود:

Sub Macro1()
Dim c As Variant
c = Sheets("sheet1").Range("b2").Value & ".xlsm"
ActiveWorkbook.SaveAs Filename:=Application.ThisWorkbook.Path & "\" & c
Workbooks.Open Filename:=ThisWorkbook.Path & "/asl.xlsm"
Workbooks("asl").Activate
Workbooks(c).Close
End Sub

امتحان کنيد ببينيد درست کار مي کند؟

دوباره سلام
آقا علی اگر من از یک فایل اکسل مثل فایل زیر 4 شیت آخر را با زبان vb در یک workbook جدید استخراج کنم چطور باید این کاربشه ؟(چون نان شیتها فارسیه نمی شه با ماکرو این کارو بکنم)
Book1,,,,,,,,,,,,,,,,,,.xlsm

[Ali Parsaei]

دوباره سلام
آقا علی اگر من از یک فایل اکسل مثل فایل زیر 4 شیت آخر را با زبان vb در یک workbook جدید استخراج کنم چطور باید این کاربشه ؟(چون نان شیتها فارسیه نمی شه با ماکرو این کارو بکنم)
Book1,,,,,,,,,,,,,,,,,,.xlsm

در مورد نام شيت ها مي توانيد از نام انگليسي پشت صحنه شيت ها استفاده کنيد. کليدهاي alt+f11 را بزنيد و نامهاي انگليسي شيتها را ببينيد، فقط در آن صورت بايد در کدها نام اصلي شيت را بنويسيد و پرانتز لازم نيست،
مثلا" براي اشاره به شيت: "گزارش عمليات" با استفاده از نام عادي آن بايد بنويسيد: ("گزارش عمليات")sheets
ولي اگر نام فارسي برايتان اشکال ايجاد مي کند و مي خواهيد از نام پشت صحنه انگليسي آن (که شيت چهار است) استفاده کنيد بايد فقط بنويسيد: Sheet4 و ديگر پرانتز و علامت: " مورد نياز نيست.
عکس را ببينيد:

[amin.t]

در مورد نام شيت ها مي توانيد از نام انگليسي پشت صحنه شيت ها استفاده کنيد. کليدهاي alt+f11 را بزنيد و نامهاي انگليسي شيتها را ببينيد، فقط در آن صورت بايد در کدها نام اصلي شيت را بنويسيد و پرانتز لازم نيست،
مثلا" براي اشاره به شيت: "گزارش عمليات" با استفاده از نام عادي آن بايد بنويسيد: ("گزارش عمليات")sheets
ولي اگر نام فارسي برايتان اشکال ايجاد مي کند و مي خواهيد از نام پشت صحنه انگليسي آن (که شيت چهار است) استفاده کنيد بايد فقط بنويسيد: Sheet4 و ديگر پرانتز و علامت: " مورد نياز نيست.
عکس را ببينيد:

سلام آقا علی برای یه شیت میشه این کارو کرد ولی اگر بخوام 4 یا 6 شیت رو با هم انتخاب و اکستراکت کرد چکار باید بکنم ؟