【VBA】Excel拆分表格，并且复制格式

需求

1、将总表根据【销售部门】拆分成不同的表格

2、拆分后保持格式不变

拆分前

拆分后

代码如下

Sub cfgzb() '拆分工作表Dim i As Integer, endrow As Integer, irow As IntegerDim sh As WorksheetDim str As Stringendrow = Sheets("总表").Range("c" & Rows.Count).End(xlUp).Row '找到最后一行的万金油公式For i = 3 To endrowstr = Sheets("总表").Range("c" & i).Value '把部门名称放入字符串str中On Error Resume Next '从该语句开始，遇到错误程序不会中止，也不会出现错误提示，将继续运行Set sh = Sheets(str) 'sh是工作表If Err.Number = 0 Then '如果部门表存在irow = sh.Range("a" & Rows.Count).End(xlUp).Row + 1 '保证新复制的数据不会覆盖原有的Sheets("总表").Rows(i).Copy sh.Rows(irow)Else '如果部门表不存在Set sh = Sheets.Add '新建工作表，交给shsh.Name = str '重命名sh.Move , Sheets(Sheets.Count) '移动工作表Sheets("总表").Rows(1).Copy sh.Rows(1) '按行复制，保留行高Sheets("总表").Rows(2).Copy sh.Rows(2)Sheets("总表").Rows(i).Copy sh.Rows(3)With sh.Cells(3, "a").Resize(1, 8).PasteSpecial xlPasteFormats  '选择性粘贴格式.PasteSpecial xlPasteColumnWidths '选择性粘贴列宽End WithEnd IfOn Error GoTo 0Next iMsgBox "拆分完成" '全部完成会有一个提示语句
End Sub

更新版本

需求

在第一版的基础上表头出现纵向合并

拆分前

拆分后

代码如下

Sub cfgzb() '拆分工作表Dim i As Integer, endrow As Integer, irow As IntegerDim sh As WorksheetDim str As Stringendrow = Sheets("总表").Range("c" & Rows.Count).End(xlUp).Row '找到最后一行的万金油公式For i = 5 To endrowstr = Sheets("总表").Range("c" & i).Value '把部门名称放入字符串str中On Error Resume Next '从该语句开始，遇到错误程序不会中止，也不会出现错误提示，将继续运行Set sh = Sheets(str) 'sh是工作表If Err.Number = 0 Then '如果部门表存在irow = sh.Range("a" & Rows.Count).End(xlUp).Row + 1 '保证新复制的数据不会覆盖原有的Sheets("总表").Rows(i).Copy sh.Rows(irow)Else '如果部门表不存在Set sh = Sheets.Add '新建工作表，交给shsh.Name = str '重命名sh.Move , Sheets(Sheets.Count) '移动工作表Sheets("总表").Range("A1:H3").Copy sh.Range("A1:H3")Sheets("总表").Rows(4).Copy sh.Rows(4) '按行复制，保留行高Sheets("总表").Rows(i).Copy sh.Rows(5)With sh.Cells(5, "a").Resize(1, 8).PasteSpecial xlPasteFormats  '选择性粘贴格式.PasteSpecial xlPasteColumnWidths '选择性粘贴列宽End WithEnd IfOn Error GoTo 0Next iMsgBox "拆分完成" '全部完成会有一个提示语句
End Sub

【VBA】Excel拆分表格，并且复制格式相关推荐

excel拆分表格怎么完成？
今天跟大家分享一下excel拆分表格怎么完成? 1.打开Excel软件,点击如下图选项 2.点击[汇总拆分]选项 3.选择[拆分工作表] 4.将[关键词所在列]设置为B列 5.最终点击[确定]即可完成 ...
excel拆分表格为多个独立文件怎么做？
今天跟大家分享一下excel拆分表格为多个独立文件怎么做? 1.打开演示文件,要求将这两个工作表分别拆分开. 2.首先我们点击下图选项 3.点击[汇总拆分]-[拆分工作簿] 4.选择要拆分处理的表格 ...
excel拆分表格为多个文件
今天跟大家分享一下excel拆分表格为多个文件 1.打开演示文件,要求将表格按照姓名数据的不同拆分为多个不同的文件 2.首先我们点击下图选项 3.点击[汇总拆分]-[拆分工作表] 4.将[表头行数]设 ...
excel拆分表格如何快速完成？
今天跟大家分享一下excel拆分表格如何快速完成? 1.打开演示文件要求将表格数据拆分开 2.首先我们点击下图选项 3.点击[汇总拆分]-[拆分工作表] 4.将[表头行数]设置为2 5.最后点击[确定 ...
excel拆分表格如何操作？
今天跟大家分享一下excel拆分表格如何操作? 1.打开演示文件,要求将这个表格快速拆分开来. 2.首先我们点击如下图选项 3.点击[汇总拆分]-选择[拆分工作表] 4.接着我们设置表头行数和关键词所 ...
excel拆分表格怎么做？
今天跟大家分享一下excel拆分表格怎么做? 1.打开演示文件,要求将表格快速删除掉. 2.接着鼠标点击如下图选项 3.再点击[汇总拆分]选择[拆分工作表] 4.接着我们将表头行数设置为2 5.再将关 ...
【excel vba】拆分表格
拆分表格并保存函数 Application主程序对象 Open 打开文件 Add 新建工作簿 Merge合并 AutoFilter(自动筛选) Offset 偏移 Msgbox和Inputbox窗口 ...
python复制excel的表格内容和格式
python向excel写内容时,格式如保复用的问题如下图,新写入的数据,要与第一列保持一致直接写数据,效果是这样的式的,显然是不行. # 定义一个函数,把df写入excel的指定位置 # sta ...
[整理][VBA]Excel合并表格
1.支持多个工作簿指定名称工作表的合并 2.支持每个工作簿第一个工作表的合并(工作表名称不相同),自动排除空白的工作表 3.支持合并每个工作簿的所有工作表 Excel2019已测试通过 VBA源码: ...

【VBA】Excel拆分表格，并且复制格式

需求

拆分前

拆分后

代码如下

需求

拆分前

拆分后

代码如下

【VBA】Excel拆分表格，并且复制格式相关推荐

最新文章

热门文章