VBA 拆分工作簿效能

2013-10-24

VBA 拆分工作簿功能各位大神，小弟最近在自学VBA，碰到一个问题，就是在将某一个工作簿中的多张表格，按照表格

VBA 拆分工作簿功能
各位大神，小弟最近在自学VBA，碰到一个问题，就是在将某一个工作簿中的多张表格，按照表格名称自动拆分到新的工作簿中。不过不知是何原因，小弟下面的代码会在For Each循环那里报下标越界的错误，跪求高人指点。

VBA 拆分工作簿效能
Sub 拆分工作簿()
Dim wk As Workbook, ss$, k%

Application.DisplayAlerts = False
For Each sht In Workbooks("工作簿综合运用（拆分工作簿）").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
VBA
[解决办法]
若你要将以上代码添加到excel 模块中应该改成这样


Sub 拆分工作簿()
Dim wk As Workbook, ss$, k%

 Application.DisplayAlerts = False
 For Each sht In ThisWorkbook.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

[解决办法]
若是vbs中的代码应该
    Dim EXCEL , xlBook
   set EXCEL = CREATEOBJECT("Excel.Application")
   Set xlBook = EXCEL.Workbooks.Open("d:\2.xlsm")
使用xlBook代替ThisWorkbook
[解决办法]

引用:

若你要将以上代码添加到excel 模块中应该改成这样


Sub 拆分工作簿()
Dim wk As Workbook, ss$, k%

 Application.DisplayAlerts = False
 For Each sht In ThisWorkbook.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


Sub 拆分工作簿()
Dim wk As Workbook, ss$, k%

 Application.DisplayAlerts = False
 For Each sht In Application.Workbooks("工作簿综合运用（拆分工作簿）.xlsx").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

热点排行