|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
请参考:
Sub 另存() '每行另存独立文件到默认目录
Application.DisplayAlerts = False '禁用警告框
Application.ScreenUpdating = False '关闭屏幕刷新
Sheets.Add After:=Sheets(Sheets.Count) '在最后建立新表
a = Application.Sheets.Count
y = Sheets("分数").Columns(1).Find("*", , xlValues, , , 2).Row '第1列最后可见非空单元行号
For i = 3 To y
Sheets("分数").Select
Sheets(a).Name = Sheets("分数").Range("a" & i).Value '重新指定表名称
Sheets(a).Range("1:2") = Sheets("分数").Range("1:2").Value
Sheets(a).Range("3:3") = Sheets("分数").Range(i & ":" & i).Value
Sheets(a).Select
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=ActiveSheet.Name & ".xls" '以当前工作表名称为文件名称另存表2
ActiveWorkbook.Close '退出当前文件(另存后的文件)
Sheets("分数").Select
Next
Sheets(a).Delete
Application.ScreenUpdating = True '打开屏幕刷新
Application.DisplayAlerts = True '恢复警告框
End Sub |
|