vba实现工作表拆分多个工作薄

已于 2022-04-27 15:39:45 修改
阅读量3.5k 收藏 16
点赞数 2
分类专栏： VBA 文章标签： Excel VBA 工作表 导出 单独文件
于 2022-04-24 20:16:38 首次发布
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/h_XUYUAN/article/details/124390796
版权

一、源表展示:

watermark,type_d3F5LXplbmhlaQ,shadow_50,text_Q1NETiBA5ZWK5Lic5LicXw==,size_20,color_FFFFFF,t_70,g_se,x_16

 二、代码部分:

Sub text()
    Dim WK As Workbook
    Dim sh As Worksheet
    Dim a As Integer
    For Each sh In ThisWorkbook.Worksheets
        Set WK = Workbooks.Add
        i = i + 1
        Workbooks(1).Sheets(i).Copy Workbooks(2).Sheets(1)
        WK.SaveAs ThisWorkbook.Path & sh.Name & ".xlsx"
        WK.Close
        Set WK = Nothing
    Next
End Sub

三、结果呈现:

watermark,type_d3F5LXplbmhlaQ,shadow_50,text_Q1NETiBA5ZWK5Lic5LicXw==,size_20,color_FFFFFF,t_70,g_se,x_16

啊东东_
关注
  • 2
    点赞
  • 踩
  • 16
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 1
    评论
专栏目录
VBA学习笔记2：将工作簿的表格拆分为工作簿
weixin_45355881的博客
04-16 1863
VBA学习笔记2：将工作簿的表格拆分为工作簿
VBA学习笔记5：将同一工作簿的数据按照类别拆分为多个工作簿
weixin_45355881的博客
04-18 2244
VBA学习笔记5：将同一工作簿的数据按照类别拆分为多个工作簿
VBA实现Excel表格根据列拆分工作簿，再由工作簿根据列拆分成工作表.txt
11-30
VBA实现Excel表格根据列拆分工作簿，再由工作簿根据列拆分成工作表，弹窗选择根据列、行，保留原工作表格式，添加打印格式
Excel·VBA按列拆分工作表、工作簿
热门推荐
hhhhh_51的博客
01-10 1万+
1，工作表按列拆分为工作表；2，工作表按列拆分为工作簿；3，工作簿按列拆分；4，工作表按列拆分，支持多列关键值；5，工作表按列拆分，先拆分为工作簿再拆分为工作表
VBA excel 表格将多行拆分成多个表格或 文件 或者合并 多个表格
最新发布
estrusKing的博客
06-05 860
为了将Excel中的数万行数据拆分成多个个每个固定行数的独立工作表，并且保留每个工作表的表头，你可以使用以下VBA脚本。这个脚本会复制表头到每个新的工作表，并将后续的数据行按固定行行的间隔进行拆分打开Excel并按下Alt + F11打开VBA编辑器。在VBA编辑器中，右键点击你的工作簿名称，然后选择插入 -> 模块，以创建一个新的模块。在新模块的代码窗口中，复制并粘贴以下VBA代码：确保你的数据在Sheet1上（或者将代码中的"Sheet1"替换为你的实际工作表名称）。
一个工作簿中的多个工作表拆分成多个工作簿
luluzsa的博客
08-14 1214
office vba
VBA快速拆分excel文件各个sheet为不同工作簿
wenjianzhiqin的博客
08-01 5420
一、需要将工作簿里面不同的sheet快速拆分成为不同的工作簿 二、代码 Sub 分拆工作表() Dim shAs Worksheet Dim MyBook As Workbook Set MyBook = ActiveWorkbook For Each shIn MyBook.Sheets sh.Copy ...
Excel 多sheet分解成多个单独excel文件（VBA记录）
qq_36333380的博客
02-23 1473
Excel 多sheet分解成多个单独excel文件（VBA记录）
VBA-拆分表格，将sheet拆成多个
06-04
VBA-拆分表格，将sheet拆成多个
使用Excel里的VBA拆分多个工作表的方法
nnnnnnnnnds的博客
12-10 1907
在Excel中，当我们需要处理包含大量数据的工作表时，有时候我们需要将一个工作薄拆分成多个工作薄，以方便数据的管理和分析。在这种情况下，使用VBA宏可以帮助我们快速、自动地完成这一任务。本文将介绍如何使用VBA拆分多个工作表。
Excel VBA 将工作表按列拆分且生成新工作簿
zylfish的博客
01-31 999
需求：已有一张总表，需要按业务员名字生成相应的工作簿，里面的工作表（sheet）命名为特定的名称。如果文件夹中已经有这个业务员工作簿且已经有同名工作表，则更新这个工作表；如果有这个业务员工作簿但没有同名工作表，则在里面新建一个工作表。1. 每一行都添加了注释，因为是帮同事写的，便于不懂任何代码的人理解。我自己也是小白，上面的代码是参考别人的代码改出来的，通过百度搜索想实现的功能，把好几段代码合在一起。2. 开头放了几个变量，用空行分隔开，方便根据表格修改。
VBA-拆分工作簿.xls
04-03
VBA-拆分工作簿.xls
多sheet分裂保存_工作簿多个sheet拆分_
09-30
以下是一个基本的VBA代码示例，用于将工作簿中的每个工作表拆分为单独的文件： ```vba Sub SplitSheets() Dim ws As Worksheet Dim wbNew As Workbook Dim savePath As String '设定保存路径 savePath = "C:\...
将Excel工作表按列拆分成多个Excel文件小工具
03-03
按列将表拆分成单独的Excel文件 将Excel表按照指定的列分组拆分并另存为单独的Excel文件 例如：A列有10条数据，汇总后是三个员工，使用小工具可以将表按照每个员工拆分成单独的Excel文件 关键点： 1、小工具要与...
VBA自定义拆分工作表窗体.xlsm
04-07
VBA自定义拆分工作表窗体.xlsm listbox窗体可选一个或多个工作表进行拆分 拆分方式有拆分为单独的工作簿，或者拆分到同一个工作簿 拆分时可选择是否复制为数值 等等
【Office】【VBA宏】使用宏实现表格中根据一列分类拆分到对应的sheet表中
qq_42285057的博客
04-24 992
VBA宏实现表格拆分（根据列分类拆分到对应的sheet表中）
Vba 一张工作表拆分多张工作表
Q215046120的博客
10-28 3994
如图，这边需要按照工作内容拆分多个工作表，直接上代码： Sub splitSht() Dim sht As Worksheet Dim d As Object Dim j As Integer Set sht = ThisWorkbook.Worksheets("Sheet1") Set d = CreateObject("scripting.dictionary") With sht rrow = .Range("A65535").End(xlUp).R...
Excel根据条件把一个工作表拆分成多个工作表
qq_35862393的博客
09-16 2582
Sub CFGZB() Dim myRange As Variant Dim myArray Dim titleRange As Range Dim title As Variant Dim columnNum As Integer myRange = Application.InputBox(prompt:="请选择标题行：", Type:=8) myArray = WorksheetFunction.Transpose(myRange) .
使用vba把一个工作簿的多个sheet拆分成两个sheet为一个工作簿的多个工作簿
xi5214的博客
01-20 2088
使用vba把一个工作簿的多个sheet拆分成两个sheet为一个工作簿的多个工作簿
VBA实现根据姓名拆分工作表
05-26
假设你有一个名为“原始数据”的工作表，其中包含所有员工的姓名和其他详细信息。现在你想要根据员工姓名将数据拆分成不同的工作表，每个工作表包含同一姓氏的所有员工信息。以下是一个简单的VBA代码实现这一操作： ```vb Sub SplitDataByLastName() Dim ws As Worksheet Dim lr As Long, i As Long Dim lastName As String Set ws = ThisWorkbook.Worksheets("原始数据") '原始数据工作表名称 lr = ws.Cells(Rows.Count, 1).End(xlUp).Row '获取最后一行 For i = 2 To lr '从第二行开始循环 lastName = Split(ws.Cells(i, 1).Value, " ")(1) '获取姓氏 If Not WorksheetExists(lastName) Then '判断工作表是否存在，不存在则新建一个工作表 Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = lastName ws.Rows(1).Copy Destination:=ActiveSheet.Range("A1") '复制第一行标题到新建的工作表 End If ws.Rows(i).Copy Destination:=Worksheets(lastName).Range("A" & Rows.Count).End(xlUp).Offset(1) '将该行数据复制到对应的工作表的最后一行 Next i End Sub Function WorksheetExists(shtName As String) As Boolean '判断工作表是否存在 WorksheetExists = False On Error Resume Next WorksheetExists = (Worksheets(shtName).Name <> "") On Error GoTo 0 End Function ``` 这段代码将逐一遍历原始数据工作表中的每一行，获取员工的姓氏，并将该行数据复制到以姓氏为名称的新工作表中。如果该姓氏的工作表不存在，则会创建一个新的工作表并将标题行复制到该工作表。最后，你将在工作簿中看到多个工作表，每个工作表包含同一姓氏的所有员工信息。
评论 1
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

啊东东_

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付：¥1
获取中
扫码支付

您的余额不足，请更换扫码支付或充值

打赏作者

实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值