vba一个按钮多个宏_多工作表拆分多工作簿，VBA一键搞定

最新推荐文章于 2021-10-28 21:14:47 发布
最新推荐文章于 2021-10-28 21:14:47 发布
阅读量1.1k 收藏 2
点赞数
文章标签： vba一个按钮多个宏
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/weixin_39629352/article/details/111334336
版权
本文介绍了如何利用VBA代码快速将Excel中的多个工作表拆分成独立的工作簿，大大提高了工作效率。操作步骤包括编写VBA代码，然后运行代码或通过按钮触发宏来实现一键拆分。此外，还提供了学习更多VBA教程的方法。
摘要由CSDN通过智能技术生成
808807e81a1d1d0f63713b90c1a18058.png如果我们要把多个工作表拆分成多工作簿，可以采用多种办法。面对重复、单调的工作，我们一定要思考能否用VBA来解决。VBA只需要编写一串代码，就能解决复杂的问题。今天我们来学习用VBA，一键搞定多工作表拆分多工作簿。操作步骤：1、编写VBA代码打开excel，鼠标右击——查看代码，输入以下代码：Sub 拆分工作表()    Dim b As Worksheet    Excel.Application.ScreenUpdating = False    For Each b In Sheets        b.Copy    Excel.ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & b.Name & ".xlsx"        Excel.ActiveWorkbook.Close    Next    Excel.Application.ScreenUpdating = TrueEnd Sub2、运行VBA代码运行就能快速将所有工作表拆分成一个个工作簿。GIF操作如下： ‍ ‍ 53f35b0524b40bc825b6a283aa64b3a8.gif

当然我们亦可以插入一个按钮，将按钮指定宏，通过按按钮，来运行宏，这样也是可以的。

如果要学习其他的VBA教程，可以在历史文章中输入：VBA，进行搜索，进行学习。

原创不易，日更不易，希望各位看官，多转发，多点赞，多支持。看完有收获，点亮：在看，分享给身边好友，一起学习，一起进步。

b208af949588410cc114d02833c85a60.png
weixin_39629352
关注
多sheet分裂保存_工作簿多个sheet拆分_
09-30
以下是一个基本的VBA代码示例，用于将工作簿中的每个工作表拆分为单独的文件： ```vba Sub SplitSheets() Dim ws As Worksheet Dim wbNew As Workbook Dim savePath As String '设定保存路径 savePath = "C:\...
vba一个按钮多个宏_用VBA编程是录制宏简单，还是手工编写代码简单？一看便知分晓...
weixin_39976413的博客
12-14 1364
Excel的强大功能相信用过Excel的人都是非常清楚的，如果再加上VBA，那对我们的工作更是如虎添翼。今天我们用Excel中自带的开发工具来实现录制字符和数字的小功能。一、用录制宏的方式来实现。1、操作方法：打开Excel(这是2010版)，选择开发工具-单击录制宏(在弹出的对话框中，有个宏名，可以改名，也可以保留直接点确定按钮确定)此时录制宏就已经开始了。2、操作步骤：①、在A1单元格输入 易...
vba一个按钮多个宏_一键合体，将多个Excel文件合并为一个文件
weixin_39833687的博客
12-11 3504
工作中 经常需将 几个Excel 文件中的 工作表 合并到 一个Excel文件 中 效果如下 ▼ ● ● ● 小窍门：将屏幕横放可放大图片！ 新建合并工作簿的宏命令 ▎ 1 “宏”在哪里？ ■ 单击工具栏上的...
vba 跳到下一个循环_常规操作控件只能执行一个宏？要设置多个不同的控件？不需要...
weixin_39863918的博客
12-14 673
VBA早间档VBA早间档，利用简单的几分钟，学习一些简单的VBA知识，提升工作效率太简单？你觉得你挤公交、挤地铁的时候能够学进入很深奥的东西嘛？今日主题按照常规逻辑来说，一个控件理论上确实是只能够指定一个宏文件的，如果我们有多个命令，可能就需要设置多个控件来连接不同的宏命令，如果对于控件没有明确的要求的话，这样的操作是没有太大的问题的，但是这样那么多个控件看起来就显得非常的凌乱，那么VBA的控件是...
实验四（邮箱）没有测试
weixin_45645133的博客
11-24 174
dns.example.com. IN A 172.18.114.1 mail.example.com. IN A 172.18.114.1 example.com. IN MX 10 mail.example.com 1.111.18.172.in-addr.arpa. IN PTR mail.example.com.
将Excel工作表按列拆分成多个Excel文件小工具
03-03
按列将表拆分成单独的Excel文件 将Excel表按照指定的列分组拆分并另存为单独的Excel文件 例如：A列有10条数据，汇总后是三个员工，使用小工具可以将表按照每个员工拆分成单独的Excel文件 关键点： 1、小工具要与...
excel 自动拆分工作簿中的多个工作表为文件
03-27
### Excel自动拆分工作簿中的多个工作表为文件 #### 概述 在日常工作中，我们经常需要处理大量的Excel数据。有时，一个工作簿中包含了多个工作表，而我们需要将这些工作表分别保存为独立的文件。手动进行这项操作...
018将总表按任意列拆分成多个工作簿共3页.pdf.zip
11-19
标题 "018将总表按任意列拆分成多个工作簿共3页.pdf.zip" 提供的信息表明，这个压缩包包含一个教程或指南，教用户如何在Excel或其他类似电子表格软件中将一个大型的总表按照特定列拆分为多个独立的工作簿。...
VBA-拆分工作簿.xls
04-03
VBA-拆分工作簿.xls
多个按钮共用一个事件（VBA）
01-13
多个按钮共用一个事件，用VBA开发的小例子。
VBA宏编程速成宝典.pdf
08-14
VBA宏编程速成宝典
excel利用宏操作拆分一个工作簿中多个工作表，使其成为多个工作簿
weixin_43859329的博客
01-17 8403
方法/步骤1: 1.打开需要处理的EXCEL文件 大图模式 方法/步骤2: 2.按alt+F11 大图模式 方法/步骤3: 3.插入一个模块 大图模式 方法/步骤4: 4.在模块中输入以下代码 Sub 拆分到工作簿()Dim wk As Workbook, ss, kApplication.DisplayAlerts = False '表示不显示警告For Each sht In Workbook...
Vba 一张工作表拆分多张工作表
Q215046120的博客
10-28 4107
如图，这边需要按照工作内容拆分多个工作表，直接上代码： 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...
【VBA】34. 一个简单的VBA宏（含按钮）
热门推荐
huiwuhuiwu的专栏
10-05 1万+
一个VBA的小程序
配置中心.zip
最新发布
09-24
配置中心
基于java的物流管理系统报告的开题报告.docx
09-24
基于java的物流管理系统报告的开题报告.docx
批量Excel 多个工作簿合并、拆分分成多个工作表vba代码
05-24
以下是一个将多个工作簿合并到一个工作表的VBA代码： ``` Sub MergeWorkbooks() Dim MyPath As String, FilesInPath As String Dim MyFiles() As String Dim SourceRcount As Long, FNum As Long Dim mybook As Workbook, BaseWks As Worksheet Dim sourceRange As Range, destrange As Range Dim rnum As Long, CalcMode As Long ' Change this to the path\folder location of your files. MyPath = "C:\MyDocuments\" ' Add a slash at the end of the path if needed. If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\" End If ' Set the file filter to find Excel files. FilesInPath = "*.xlsx*" ' Set the first result file number to 0. FNum = 0 ' Loop through all files in the folder. If Dir(MyPath & FilesInPath) = "" Then MsgBox "No files found." Exit Sub End If ' Turn off calculation and screen updating. With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With ' Set the base worksheet for the merge. Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1) ' Loop through all files. Do While Dir(MyPath & FilesInPath) <> "" ' Add to the file count. FNum = FNum + 1 ' Re-dimension the array to hold the new file name. ReDim Preserve MyFiles(1 To FNum) ' Store the file name. MyFiles(FNum) = Dir(MyPath & FilesInPath) ' Go to the next file name. DirCount = DirCount + 1 Dir Loop ' Set the starting row for the copy. rnum = 1 ' Loop through all files and worksheets, copying the data to the base worksheet. For FNum = 1 To UBound(MyFiles) Set mybook = Workbooks.Open(MyPath & MyFiles(FNum)) For Each sourceSheet In mybook.Worksheets ' Find the last row of data on the source worksheet. SourceRcount = sourceSheet.Cells(Rows.Count, "A").End(xlUp).Row ' Set the source range. Set sourceRange = sourceSheet.Range("A1:Z" & SourceRcount) ' Copy the data to the base worksheet. Set destrange = BaseWks.Range("A" & rnum) sourceRange.Copy destrange ' Increase the row counter. rnum = rnum + SourceRcount Next sourceSheet mybook.Close savechanges:=False Next FNum ' Turn on calculation and screen updating. With Application .Calculation = CalcMode .ScreenUpdating = True End With ' Auto-fit the columns on the base worksheet. BaseWks.Columns.AutoFit End Sub ``` 以下是将工作表拆分为多个工作簿的VBA代码： ``` Sub SplitWorkbook() Dim FileExtStr As String Dim FileFormatNum As Long Dim xWs As Worksheet Dim xWb As Workbook Dim FolderName As String Dim Lrow As Long Dim OutFolder As String ' Change this to the path\folder location where you want to save the new files. OutFolder = "C:\MyDocuments\" ' Create a new folder for the output files. If Len(Dir(OutFolder, vbDirectory)) = 0 Then MkDir OutFolder End If ' Only save the active sheet. Set xWs = Application.ActiveSheet ' Get the file extension and format number. FileExtStr = ".xlsx" FileFormatNum = 51 ' Find the last row of data on the active sheet. Lrow = xWs.Cells(xWs.Rows.Count, "A").End(xlUp).Row ' Turn off calculation and screen updating. Application.ScreenUpdating = False Application.DisplayAlerts = False ' Loop through each row of data and save each row to a new file. For i = 2 To Lrow ' Create a new workbook. Set xWb = Application.Workbooks.Add ' Save the new workbook to the output folder. FolderName = OutFolder & xWs.Cells(i, "A").Value & FileExtStr ' Save the active sheet to the new workbook in the output folder. xWs.Rows(i).Copy xWb.Worksheets(1).Range("A1").PasteSpecial xlPasteAll ' Save and close the new workbook. xWb.SaveAs FolderName, FileFormatNum xWb.Close False Next i ' Turn on calculation and screen updating. Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub ``` 注意，这些代码应该修改以适应您的具体情况。
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

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

余额充值