拆分工作表小工具(实用工具)

一张销售订单总表,需要按照销售员拆分成多个单表,除了按照销售员一个个筛选、复制到新文件,是否可以用vba来做呢。

相信很多同学都遇到过如下使用工作情形:一张销售订单总表,需要按照销售员拆分成多个单表,除了按照销售员一个个筛选、复制到新文件,是否可以用vba来做呢?该怎么做呢?案例案例名称

待拆分工作表.xlsx:

拆分工作表小工具(实用工具)

按照姓名拆分成“张三.xlsx”、“李四.xlsx”和“王二.xlsx”。

你只需要打开附件中的“按照第一列拆分表格.xlsm”,点击拆分按钮即可。

这个vba程序我已经包装好,按照说明使用就可以了,如果需要学习代码,代码也未加密,可以直接查看。

工具获取方法:

一、将本文分享到朋友圈,并截图;

二、将截图私信发送给本号,我将会回复给您百度网盘下载的地址和提取码。

关键代码:

Sub main_module()

Application.ScreenUpdating = True

‘打开待拆分表格

Dim bookA As Workbook

Dim sheetA As Worksheet

Dim rowcountA As Long

Dim resDicA As Object

Set resDicA = CreateObject(“Scripting.Dictionary”)

Call public_module.getObjs(ThisWorkbook.path & “\待拆分表格.xlsx”, “Sheet1”, resDicA)

Set bookA = resDicA.Item(“book”)

Set sheetA = resDicA.Item(“sheet”)

rowcountA = resDicA.Item(“sheetRowsCount”)

‘新建文件对象

Set fso = CreateObject(“scripting.filesystemobject”)

‘循环第一列

Dim filename1, filename As String

Dim i

For i = 2 To rowcountA

filename1 = sheetA.Cells(i, 1)

If Trim(filename1) <> “” Then

filename = filename1

Else

filename = “筛选值为空”

End If

filenamelong = filename & “.xlsx”

If fso.FileExists(ThisWorkbook.path & “\” & filenamelong) = True Then

‘MsgBox “文件存在”

Else

‘MsgBox filename & “文件不存在”

Set newbk = Workbooks.Add

sheetA.[a1].AutoFilter 1, filename1

sheetA.[a1].CurrentRegion.SpecialCells(xlCellTypeVisible).Copy newbk.Sheets(1).[a1]

dirname = ThisWorkbook.path & “\” & filenamelong

ActiveWorkbook.SaveAs dirname

Workbooks(filenamelong).Close True

Application.ScreenUpdating = True

End If

Next i

bookA.Close Savechanges:=True

End Sub

拆分工作表小工具(实用工具)

免责声明:本站所有文章内容,图片,视频等均是来源于用户投稿和互联网及文摘转载整编而成,不代表本站观点,不承担相关法律责任。其著作权各归其原作者或其出版社所有。如发现本站有涉嫌抄袭侵权/违法违规的内容,侵犯到您的权益,请在线联系站长,一经查实,本站将立刻删除。 本文来自网络,若有侵权,请联系删除,如若转载,请注明出处:https://itzsg.com/10249.html

(0)
上一篇 2023年 4月 22日 下午11:57
下一篇 2023年 4月 22日 下午11:57

相关推荐

发表回复

您的邮箱地址不会被公开。 必填项已用 * 标注

联系我们YX

mu99908888

在线咨询: 微信交谈

邮件:itzsgw@126.com

工作时间:时刻准备着!

关注微信