جداسازی شیت های اکسل در پوشه جداگانه

[ali.b]

سلام با این کد میتونید همه شیت های ی فایلتون رو جدا کنین و در پوشه مورد نظر ذخیره کنین
درضمن این کد مشکلات نوع و پسوند فایل رو نداره و برای همه نوع فایل اکسل جواب میده

Sub SplitWorkbook()'Updateby20140612
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = xWb.Path & "\" & xWb.Name & " " & DateString
MkDir FolderName
For Each xWs In xWb.Worksheets
xWs.Copy
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
Select Case xWb.FileFormat
Case 51:
FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If Application.ActiveWorkbook.HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56:
FileExtStr = ".xls": FileFormatNum = 56
Case Else:
FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
Application.ActiveWorkbook.Close False
Next
MsgBox "You can find the files in " & FolderName
Application.ScreenUpdating = True
End Sub

[ali.b]

این کد زمانی به درد شما میخوره که میخواین بعد از فرایندی مثلا گزارش گیری فقط شیت هایی که مد نظرتون هست در در شیت های جداگانه ( نه یک فایل جداگانه!) براتون ذخیره بشه

برای حالت داخل پرانتز از تایپیک زیر استفاده کنین
جداسازی شیت های موردنظر (http://forum.exceliran.com/showthread.php?5444-%D8%AC%D8%AF%D8%A7%D8%B3%D8%A7%D8%B2%DB%8C-%D8%B4%DB%8C%D8%AA-%D9%87%D8%A7%DB%8C-%D9%85%D9%88%D8%B1%D8%AF%D9%86%D8%B8%D8%B1&p=27564#post27564)