最近接手了计算工资的工作,计算完之后需要把每个人的工资明细单独保存,一个一个操作太过繁琐,写了一个VBA程序,分享一下:效果如图
代码如下:(直接复制可用,基于Excel2019实验,Win10系统)
Sub SplitWorksheetsToSeparateFiles()
Dim wb As Workbook, newWb As Workbook
Dim ws As Worksheet
Dim outputPath As String
设置要拆分的工作薄路径和输出文件夹路径,
路径可以自行设置,我直接保存在桌面文件夹中
需要拆分的文件名需要自行输入
Set wb = Workbooks.Open("C:\Users\Admin\Desktop\1\4月明细.xls")
outputPath ="C:\Users\Admin\Desktop\1\"
遍历所有工作表
For Each ws In wb.Worksheets
创建新工作薄并将当前工作表复制到其中
Set newWb = Workbooks.Add
ws.Copy After:=newWb.Sheets(newWb.Sheets.Count)
保存新工作薄为单独的文件
newWb.SaveAs Filename:=outputPath & ws.Name &".xlsx", FileFormat:=51
关闭新工作薄
newWb.Close SaveChanges:=False
Next
关闭原始工作薄
wb.Close SaveChanges:=False
End Sub
(代码使用方法,直接新建一个工作薄,打开开发工具-->Visual Basic-->复制粘贴代码,运行即可)