拆分到工作簿VBA

nnsea

Sub 拆分到工作簿()
Dim wk As Workbook, ss$, k%
Application.DisplayAlerts = False
For Each sht In Workbooks("2-11.工作簿综合运用(拆分工作簿)").Sheets
    Set wk = Workbooks.Add
    k = k + 1
    Workbooks(1).Sheets(k).Copy Workbooks(2).Sheets(1)
    ss = ThisWorkbook.Path & "\" & sht.Name & ".xlsx"
    wk.SaveAs ss
    wk.Close
Next
Application.DisplayAlerts = True
MsgBox "拆分工作簿完成！"
End Sub