|
本帖最后由 smsn 于 2014-12-20 23:08 编辑
大家好!
假设现在有excel 123.xls,想要一次性提取每个sheet 保存 成一个单独的文件,文件名字为 sheet名字.xls,保存位置为 A.xls 旁的 “sheets”文件夹。
"sheet"这个文件夹 得有VBA来创建。
请问各位高手,地下代码为什么生成的密码都乱了?
Sub Savesheetstofiles()
Dim sht As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
MkDir ThisWorkbook.Path & "\Sheets"
For Each sht In Sheets
sht.Copy
Select Case Pwdadd
Case sht.Name = "CAT"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Sheets\" & sht.Name & ".xls", FileFormat:=xlExcel8, Password:="1", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Case sht.Name = "CQS"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Sheets\" & sht.Name & ".xls", FileFormat:=xlExcel8, Password:="2", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Case sht.Name = "CTS"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Sheets\" & sht.Name & ".xls", FileFormat:=xlExcel8, Password:="3", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Case sht.Name = "DGF"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Sheets\" & sht.Name & ".xls", FileFormat:=xlExcel8, Password:="4", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Case sht.Name = "EXP"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Sheets\" & sht.Name & ".xls", FileFormat:=xlExcel8, Password:="5", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Case sht.Name = "GTL"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Sheets\" & sht.Name & ".xls", FileFormat:=xlExcel8, Password:="6", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Case sht.Name = "KWE"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Sheets\" & sht.Name & ".xls", FileFormat:=xlExcel8, Password:="7", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Case sht.Name = "LSD"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Sheets\" & sht.Name & ".xls", FileFormat:=xlExcel8, Password:="8", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Case sht.Name = "NCN"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Sheets\" & sht.Name & ".xls", FileFormat:=xlExcel8, Password:="9", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Case sht.Name = "OCS"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Sheets\" & sht.Name & ".xls", FileFormat:=xlExcel8, Password:="10", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Case sht.Name = "PEN"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Sheets\" & sht.Name & ".xls", FileFormat:=xlExcel8, Password:="11", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Case sht.Name = "SFT"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Sheets\" & sht.Name & ".xls", FileFormat:=xlExcel8, Password:="12", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Case sht.Name = "YAS"
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Sheets\" & sht.Name & ".xls", FileFormat:=xlExcel8, Password:="13", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
End Select
ActiveWorkbook.Close
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
|
|