拆分工作簿加密码

独孤逸盛

如何把拆分的工作表加上123456的密码
Sub 拆分工作表到工作簿()
Dim ws As Worksheet, wb As Workbook
Application.DisplayAlerts = False
    Workbooks.Add
    ThisWorkbook.Sheets("国际信誉保障产品").Copy Worksheets(1)
    ThisWorkbook.Sheets("全球会议").Copy Worksheets(1)
    ThisWorkbook.Sheets("口岸俱乐部").Copy Worksheets(1)
    ThisWorkbook.Sheets("联合参展 ").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "国际信誉保障产品+全球会议+口岸俱乐部+联合参展" & ".xlsx"
    ActiveWorkbook.Close
    '==================================================================
    Workbooks.Add
    ThisWorkbook.Sheets("中国营销揽货产品").Copy Worksheets(1)
    ThisWorkbook.Sheets("企微货代圈").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "中国营销揽货产品+企微货代圈" & ".xlsx"
    ActiveWorkbook.Close
    '====================================================================
    Workbooks.Add
    ThisWorkbook.Sheets("数据通道").Copy Worksheets(1)
    ThisWorkbook.Sheets("产品设计中心").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "数据通道+产品设计中心" & ".xlsx"
    ActiveWorkbook.Close
    '====================================================================
    Workbooks.Add
    ThisWorkbook.Sheets("保险").Copy Worksheets(1)
    ThisWorkbook.Sheets("技术" & "（" & "研发" & "）").Copy Worksheets(1)
    ThisWorkbook.Sheets("技术" & "（" & "运维" & "）").Copy Worksheets(1)
    ThisWorkbook.Sheets("技术" & "-" & "企业管理").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "保险+技术研发+技术运费+技术企业管理" & ".xlsx"
    ActiveWorkbook.Close
    '===========================================================================
    Workbooks.Add
    ThisWorkbook.Sheets("国内销售").Copy Worksheets(1)
    ThisWorkbook.Sheets("海外销售").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "销售部" & ".xlsx"
    ActiveWorkbook.Close
    Workbooks.Add
    ThisWorkbook.Sheets("国内客成").Copy Worksheets(1)
    ThisWorkbook.Sheets("海外客成").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "客成部" & ".xlsx"
    ActiveWorkbook.Close
'=============================================================================
    Workbooks.Add
    ThisWorkbook.Sheets("中国营销揽货产品").Copy Worksheets(1)
    ThisWorkbook.Sheets("企微货代圈").Copy Worksheets(1)
    ThisWorkbook.Sheets("TCS").Copy Worksheets(1)
    ThisWorkbook.Sheets("美元快付").Copy Worksheets(1)
    ThisWorkbook.Sheets("JCPAY ").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "中国营销揽货产品+企业货代圈+TCS+美元快付+JCPAY" & ".xlsx"
    ActiveWorkbook.Close
'===========================================================
    Workbooks.Add
    ThisWorkbook.Sheets("客情").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "客情" & ".xlsx"
    ActiveWorkbook.Close
    Workbooks.Add
    ThisWorkbook.Sheets("人事").Copy Worksheets(1)
    ThisWorkbook.Sheets("行政").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "人事+行政" & ".xlsx"
    ActiveWorkbook.Close
'=============================================================================
    Workbooks.Add
    ThisWorkbook.Sheets("整合营销" & "（" & "投放" & "）").Copy Worksheets(1)
    ThisWorkbook.Sheets("整合营销" & "（" & "品牌" & "）").Copy Worksheets(1)
    ThisWorkbook.Sheets("整合营销" & "-" & "企业管理").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "整合营销" & ".xlsx"
    ActiveWorkbook.Close
'============================================================================
    Workbooks.Add
    ThisWorkbook.Sheets("业管").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "业务管理部" & ".xlsx"
    ActiveWorkbook.Close
'=====================================================================================
    Workbooks.Add
    ThisWorkbook.Sheets("财务" & "（" & "总部" & "）").Copy Worksheets(1)
    ThisWorkbook.Sheets("财务" & "（" & "TCS" & "）").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "财务总部+财务TCS" & ".xlsx"
    ActiveWorkbook.Close
'=====================================================================================
    Workbooks.Add
    ThisWorkbook.Sheets("项目管理部").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "项目管理部" & ".xlsx"
    ActiveWorkbook.Close
'=====================================================================================
    Workbooks.Add
    ThisWorkbook.Sheets("风控" & "（" & "海外产品" & "）").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "风控海外产品" & ".xlsx"
    ActiveWorkbook.Close
'=====================================================================================
    Workbooks.Add
    ThisWorkbook.Sheets("风控" & "（" & "TCS" & "）").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "风控TCS" & ".xlsx"
    ActiveWorkbook.Close
'=====================================================================================
    Workbooks.Add
    ThisWorkbook.Sheets("运营" & "（" & "公共" & "）").Copy Worksheets(1)
    ThisWorkbook.Sheets("运营" & "（" & "海外产品" & "）").Copy Worksheets(1)
    ThisWorkbook.Sheets("运营" & "（" & "会议" & "）").Copy Worksheets(1)
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "运营" & ".xlsx"
    ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub

ykcbf1100

这其实属于多表拆分为多工作簿多表，不难，但要有附件。现有代码明显存在问题。