通过VBA将一个工作簿中的多个工作表拆分为多个工作簿,以工作表名称命名工作簿

前提：电脑上装有office2007或office2013等，WPS不行。

1、如果你有现成的一个工作簿含有多个工作表的文件，想分成多个工作簿的话，
可以通过office2007或office2013等打开execl，然后通过execl里面的开发工具，
输入以下运行代码，执行就行（拆分的工作簿在你设置的路径下）：

Sub cfb()
Dim m As Integer
Dim sht, sht1 As Worksheet
'按照需要将分出来的表分成多个工作簿
n = InputBox(“请输入excel的路径”)
For Each sht1 In Sheets
sht1.Copy
ActiveWorkbook.SaveAs Filename:=n & “” & sht1.Name & “.xlsx”
ActiveWorkbook.Close
Next
End Sub

2、如果你的工作簿里只有一个工作表，但是需要根据工作表中的某个字段拆分成多个工作簿，并且以该字段值命名工作簿的话，输入以下运行代码，执行就行（拆分的工作簿在你设置的路径下）：

Sub cfb()
Dim i, j, k, l, m As Integer
Dim sht, sht1 As Worksheet
m = InputBox(“想按照第几列分表!”)
'分表前先删除多余表（将需要的工作表放最前方就行）
Application.DisplayAlerts = False
If Sheets.Count > 1 Then
For i = Sheets.Count To 2 Step -1
Sheets(i).Delete
Next
End If
'通过字段名进行建表,注意需要建表的字段不能违反表名规则
j = Sheet1.Range(“a65536”).End(xlUp).Row
For i = 2 To j
k = 0
For Each sht In Sheets
If sht.Name = Sheet1.Cells(i, m) Then
k = 1
End If
Next
If k = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet1.Cells(i, m)
End If
Next
'通过已知到的表名进行数据筛选赋值拷贝数据
For l = 2 To Sheets.Count
Sheet1.Range(“a1:iv65536”).AutoFilter Field:=m, Criteria1:=Sheets(l).Name
Sheet1.Range(“a1:iv65536”).Copy Sheets(l).Range(“a1”)
Next
Sheet1.Range(“a1:iv65536”).AutoFilter
'按照需要将分出来的表分成多个工作簿
m = InputBox(“是否需要分成多个工作簿：1.是，2.否”)
If m = 1 Then
n = InputBox(“请输入excel的路径”)
For Each sht1 In Sheets
sht1.Copy
ActiveWorkbook.SaveAs Filename:=n & “” & sht1.Name & “.xlsx”
ActiveWorkbook.Close
Next
End If
End Sub

3、如果你有现成的一个工作簿含有多个工作表的文件，想分成多个工作簿，并且有隐藏工作表时，弹出输入框，选择是否执行或显示当前隐藏的工作表。输入以下运行代码，执行就行（拆分的工作簿在当前目录的"拆分"文件夹中）：

Sub cfb()
Application.ScreenUpdating = False
Dim xpath, isNext As String
Dim sht As Worksheet
xpath = Application.ActiveWorkbook.Path & “\拆分”
'如果文件夹不存在，则新建文件夹
If Len(Dir(xpath, vbDirectory)) = 0 Then MkDir xpath
For Each sht In Worksheets
If sht.Visible = False Then
'MsgBox “有隐藏工作表” & sht.Name
'隐藏工作表是否拆分
isNext = InputBox(“1:跳过不处理” & Chr(10) & “2:处理” & Chr(10) & “空:默认不处理”, “【” & sht.Name & “】为隐藏工作表,请选择执行方式”)
If isNext = “2” Then
sht.Visible = True '取消工作表的隐藏
sht.Copy
ActiveWorkbook.SaveAs Filename:=xpath & “” & sht.Name & “.xlsx”
ActiveWorkbook.Close
sht.Visible = False '恢复工作表的隐藏
End If
ElseIf sht.Visible = True Then
sht.Copy
ActiveWorkbook.SaveAs Filename:=xpath & “” & sht.Name & “.xlsx”
ActiveWorkbook.Close
End If
Next
'MsgBox “工作簿拆分完成”
Application.ScreenUpdating = True '恢复屏幕更新
End Sub

以上就是大致的拆分情况。

通过VBA将一个工作簿中的多个工作表拆分为多个工作簿,以工作表名称命名工作簿相关推荐

abap中读取excel中不同的sheet数据_Python 如何将数据写入Excel的不同或同一个工作簿中...
在进行日常的数据分析统计时,很多时候我们需要将不同数据写入到同一个Excel文件的不同工作簿或同一个工作簿中.本文主要介绍 Python 如何将多个 DataFrame 写入同一个 Excel 不同或 ...
Excel如何在整个工作簿中批量替换指定数据
今天跟大家分享一下Excel如何在整个工作簿中批量替换 1.下面以下图为例跟大家介绍一下怎么批量替换整个工作簿数据. 2.首先我们点击下图选项 3.单击[更多].[批量替换] 4.选择全部工作表,然后 ...
批量重命名工作簿中的工作表名
一.批量重命名一个工作簿中的所有工作表工作簿中有10个工作表,每张工作表的名字中都带有"2020年"字样,想把这几个字去掉.虽然说一个一个的重命名也花不了多少时间,但是如果这个工 ...
工作表拆分成分表的2种情况及处理方式
在日常经营统计分析工作中,常常需要进行报表的拆分,主要拆分的情形有2种: 1.将某工作簿中的所有工作表拆分后,分表独立保存到该工作簿所在的文件夹中 2.按照一定的业务条件(如日期.地区.渠道等),从总 ...
VBA：获取工作簿中所有表的名称、地址
####一.目的一个工作簿中有很多的表,想提取所有表的名称和地址,方便后期公式的使用 ####二.方法 1. 使用VBA代码 Sub 提取所有工作表的名称()For Each x In Sheets ...
写一段vba代码，把excel中所有工作簿中的图片删除
以下是 VBA 代码,可用于删除 Excel 中所有工作簿中的图片: Sub DeleteAllImages()Dim ws As WorksheetDim shp As ShapeFor Each ...
VBA 批量打开workbook工作簿，汇总到同一workbook工作簿中
** VBA 批量打开workbook工作簿,汇总到同一workbook工作簿中 ** 前言:此VBA程序,通用! Sub 收集文件夹中文件路径() Dim f'1.批量打开文件,将文件路径记录到数组 ...
VBA实战技巧精粹004：在工作簿中添加新工作表
使用Worksheets集合或Sheets集合的Add方法可以实现在指定位置添加新工作表,并且添加后的新工作表自动为活动工作表. Sub 插入新工作表并改名() With Worksheets ...
如何使用VBA实现将工作簿中全部表格转换为区域
工作表中的表格(有时也被称为超级表格)具备自动扩展等诸多功能,有时需要将表格转换为普通单元格区域,在Excel中操作很简单. 步骤1 选中表格中的任意单元格. 步骤2 依次单击[表设计]>> ...

通过VBA将一个工作簿中的多个工作表拆分为多个工作簿,以工作表名称命名工作簿

通过VBA将一个工作簿中的多个工作表拆分为多个工作簿,以工作表名称命名工作簿相关推荐

最新文章

热门文章