VBA代码合集（更新2023.01.05）

VBA拆分工作簿

VBA合并工作簿

VBA合并工作表

VBA一键批量修改工作表名称

VBA多个Excel合并为1个文件多个工作表

VBA拆分工作簿

Sub 拆分工作薄()Dim xpath As Stringxpath = ActiveWorkbook.PathDim sht As WorksheetFor Each sht In ActiveWorkbook.Sheetssht.CopyActiveWorkbook.SaveAs Filename:=xpath & "\" & sht.Name & ".xlsx" '将文件存放在工作薄所在的位置ActiveWorkbook.CloseNextMsgBox "拆分完毕！"
End Sub

VBA合并工作簿

Sub 合并当前目录下所有Excel文件()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
AWbName = ActiveWorkbook.Name
Num = 0
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
Num = Num + 1
With Workbooks(1).ActiveSheet
.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
For G = 1 To Sheets.Count
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
Next
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop
Range("B1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个Excel文件下的全部工作表。如下：" & Chr(13) & WbN,vbInformation, "提示"
End Sub

VBA合并工作表

Sub 合并当前工作簿下的所有工作表()
Application.ScreenUpdating = False
For j = 1 To Sheets.CountIf Sheets(j).Name  ActiveSheet.Name ThenX = Range("A65536").End(xlUp).Row + 1Sheets(j).UsedRange.Copy Cells(X, 1)End If
Next
Range("B1").Select
Application.ScreenUpdating = True
MsgBox "当前Excel的全部工作表已经合并完毕！", vbInformation, "提示"
End Sub

VBA一键批量修改工作表名称

Sub 一键获取工作表名称()
Dim sht As Worksheet, k&
[A:A] = ""
[A1] = "原工作表名称"
j = 1
For Each sht In Worksheets
j = j + 1
Cells(j, 1) = sht.Name
Next
End SubSub 一键修改工作表名称()
Dim shtname$, sht As Worksheet, i&
On Error Resume Next
For i = 1 To Cells(Rows.Count, 1).End(3).Row
shtname = Cells(i, 1)
Set sht = Sheets(shtname)
If Err = 0 Then
Sheets(shtname).Name = Cells(i, 2)
Else
Err.Clear
End If
Next
End Sub

VBA多个Excel合并为1个文件多个工作表

Sub Books2Sheets()'定义对话框变量Dim fd As FileDialogSet fd = Application.FileDialog(msoFileDialogFilePicker)'新建一个工作簿Dim newwb As WorkbookSet newwb = Workbooks.AddWith fdIf .Show = -1 Then'定义单个文件变量Dim vrtSelectedItem As Variant'定义循环变量Dim i As Integeri = 1'开始文件检索For Each vrtSelectedItem In .SelectedItems'打开被合并工作簿Dim tempwb As WorkbookSet tempwb = Workbooks.Open(vrtSelectedItem)'复制工作表tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)'把新工作簿的工作表名字改成被复制工作簿文件名，这儿应用于xlsx文件，即Excel2007的文件，如果是Excel97-2003，需要改成xlsnewwb.Worksheets(i).Name = VBA.Replace(tempwb.Name, ".xlsx", "")'关闭被合并工作簿tempwb.Close SaveChanges:=Falsei = i + 1Next vrtSelectedItemEnd IfEnd WithSet fd = NothingMsgBox Prompt:="合并完成", Buttons:=vbInformation + vbOKCancel, Title:="逗号Office技巧"End Sub

VBA代码合集（更新2023.01.05）相关推荐

自己写的实用VBA代码合集
1.遍历所有已打开的word文档 For Each docOpened In Documents-- Next docOpened 2.Word 将目录下所有文档转换为txt,并删除原文档 Sub 目 ...
自己写的实用VBA代码合集√
1.遍历所有已打开的word文档 For Each docOpened In Documents-- Next docOpened 2.Word 将目录下所有文档转换为txt,并删除原文档 Sub 目 ...
【最新】整理了CVPR 2023论文代码合集！
CVPR 2023 顶会论文接收结果出炉啦!CVPR 2023 主委会官方发布这次论文接收数据:有效投稿 9155 篇(比 CVPR 2022 增加12%),收录 2360 篇,接收率为 25.78 ...
2013计算机视觉代码合集
注:下面有project网站的大部分都有paper和相应的code.Code一般是C/C++或者Matlab代码. 最近一次更新:2013-9-7 一.特征提取Feature Extraction: ...
YOLOv3最全复现代码合集（含PyTorch/TensorFlow和Keras等）
点击上方"CVer",选择"置顶公众号" 重磅干货,第一时间送达前戏 2018年3月26日,CVer第一时间推文:YOLOv3:你一定不能错过 2019年3月 ...
iOS开发中经常用的实用代码合集
iOS开发中经常用的实用代码合集本文整理了,在iOS开发中我们所遇到一些开发问题的技巧类的代码,让你在开发过程中避免了很多弯路,希望能给你的开发带来帮助和启发. 1.判断邮箱格式是否正确的代码: / ...
王道考研机试指南代码合集
王道考研机试指南代码合集 github链接王道考研机试指南的代码合集,附有一些笔记和感悟文件夹中包括机试指南的pdf,笔记部分,和代码对应题目的列表如发现任何问题欢迎在下面留言更新: 最短路题 ...
UIUC同学Jia-Bin Huang收集的计算机视觉代码合集（ZZ）
UIUC同学Jia-Bin Huang收集的计算机视觉代码合集(ZZ) 链接如下: http://www.cnblogs.com/idaidai/archive/2012/03/01/2375800. ...
python爱心代码合集
python爱心代码合集一行代码画爱心输出 I 爱 U 填充型动态画红心桃心线性立体红心画一朵玫瑰花画树附录一行代码画爱心 print('\n'.join([''.join([(' ...

VBA代码合集（更新2023.01.05）

VBA拆分工作簿

VBA合并工作簿

VBA合并工作表

VBA一键批量修改工作表名称

VBA多个Excel合并为1个文件多个工作表

VBA代码合集（更新2023.01.05）相关推荐

最新文章

热门文章