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

**Ali Parsaei** · 2015/03/13, 01:08

سلام،
فرض کنيم فايلي داريد با دو شيت 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** · 2015/03/15, 12:56

نوشته اصلی توسط علي پارسا

سلام،
فرض کنيم فايلي داريد با دو شيت 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** · 2015/03/16, 00:29

يعني فايل فعال عينا" يک کپي ازش تهيه بشود؟
اون وقت بايد يک فکري هم براي نام فايل جديد نمود وگرنه با انجام چند باره ماکرو مورد نظر، هر دفعه که کپي مي گيريد روي کپي قبلي 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** · 2015/03/16, 02:10

نوشته اصلی توسط علي پارسا

يعني فايل فعال عينا" يک کپي ازش تهيه بشود؟
اون وقت بايد يک فکري هم براي نام فايل جديد نمود وگرنه با انجام چند باره ماکرو مورد نظر، هر دفعه که کپي مي گيريد روي کپي قبلي 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** · 2015/03/16, 14:58

فرض کنيم نام فايل اصلي شما 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** · 2015/04/04, 00:33

نوشته اصلی توسط علي پارسا

سلام،
فرض کنيم فايلي داريد با دو شيت 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** · 2015/04/09, 02:57

نوشته اصلی توسط 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** · 2015/04/10, 01:20

نوشته اصلی توسط amin.t

دوباره سلام
آقا علی اگر من از یک فایل اکسل مثل فایل زیر 4 شیت آخر را با زبان vb در یک workbook جدید استخراج کنم چطور باید این کاربشه ؟(چون نان شیتها فارسیه نمی شه با ماکرو این کارو بکنم)
[ATTACH]6535[/ATTACH]

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

**amin.t** · 2015/04/12, 11:34

نوشته اصلی توسط علي پارسا

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

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

**Ali Parsaei** · 2015/04/13, 16:10

نوشته اصلی توسط amin.t

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

خوب فايل را کلا" save as کنيد بعد شيت هاي اضافه را delete کنيد، کد delete کردن شيت را هم با ضبط يک ماکرو به سادگي مي توانيد بيابيد.

**ظهور 313** · 2018/06/04, 16:21

نوشته اصلی توسط 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

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

**Amir Ghasemiyan** · 2018/06/05, 12:13

نوشته اصلی توسط ظهور 313

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

سلام دوست عزيز
كافيه اين چند خط كد رو به انتهاي كد اضافه كنيد

کد:

Cells.Copy Cells.PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False ActiveWorkbook.Save