宏代码合并工作表.docx
- 文档编号:24624492
- 上传时间:2023-05-29
- 格式:DOCX
- 页数:13
- 大小:648.95KB
宏代码合并工作表.docx
《宏代码合并工作表.docx》由会员分享,可在线阅读,更多相关《宏代码合并工作表.docx(13页珍藏版)》请在冰豆网上搜索。
宏代码合并工作表
宏代码—工作表合并
一、关于宏的EXCEL设置
1.设置快捷宏图标:
文件—EXCEL选项-常用-在功能区显示“开发工具〞选项卡打钩
2.删除宏:
宏-选中相应的宏-删除
3.取消出现平安隐私警告:
EXCEL选项-信任中心-信任中心设置-个人信息选项-将〞保存时从文件属性中删除个人信息“前面的勾去掉
二、合并当前工作簿下的所有工作表
1.我们现在开始合并,首先要在最前页新建一个工作表。
如图:
步骤阅读
2.在新建的sheet表中“右键〞,找到“查看代码〞,然后看到宏计算界面。
如下图:
步骤阅读
步骤阅读
看到宏计算界面,我们就只需要把下面的代码复制进去,代码如下,效果如下:
Sub合并当前工作簿下的所有工作表()
Application.ScreenUpdating=False
IfSheets(j).Name<>ActiveSheet.NameThen
X=Range("A65536").End(xlUp).Row+1
Sheets(j).UsedRange.CopyCells(X,1)
EndIf
Next
Range("B1").Select
Application.ScreenUpdating=True
MsgBox"当前工作簿下的全部工作表已经合并完毕!
",vbInformation,"提示"
EndSub
或者如下:
Sub 合并()
For I = 2 To '如果工作表的第一行都一样,就把下 Rows("1" & 的1改成2就好了
Sheets(I).Rows("1" & ":
" & Sheets(I).Range("A60000").End(xlUp).Row). _
Copy Range("A" & Range("A60000").End(xlUp).Row + 1)
Next
End Sub
步骤阅读
1.
3.点击工具栏上面的“运行〞下的“运行子过程/用户窗体〞就可以了,合并完之后会有提示。
提示完成之后就可以把宏计算界面关闭了。
如下图:
步骤阅读
记得删除宏,详细操作见一
5.删除多余的首行标题:
工作表全选—自动筛选—选择列〔建议选择文本选项少的列〕--勾选重复的标题与空白—删除重复标题与空白
三、合并当前目录下所有工作簿的全部工作表
1.我们需要把多个excel表都放在同一个文件夹里面,并在这个文件夹里面新建一个excel。
如下图:
2.用microsoftexcel翻开新建的excel表,并右键单击sheet1,找到“查看代码〞,单击进去。
进去之后就看到了宏计算界面。
如下图:
步骤阅读
步骤阅读
3.然后我们把下面这些宏计算的代码复制进去〔注意XLS或者XLSX〕,代码如下,如下图:
Sub合并当前目录下所有工作簿的全部工作表()
DimMyPath,MyName,AWbName
DimWbAsWorkbook,WbNAsString
DimGAsLong
DimNumAsLong
DimBOXAsString
Application.ScreenUpdating=False
MyName=Dir(MyPath&"\"&"*.xls")
Num=0
DoWhileMyName<>""
IfMyName<>AWbNameThen
SetWb=Workbooks.Open(MyPath&"\"&MyName)
Num=Num+1
WithWorkbooks
(1).ActiveSheet
.Cells(.Range("B65536").End(xlUp).Row+2,1)=Left(MyName,Len(MyName)-4)
Wb.Sheets(G).UsedRange.Copy.Cells(.Range("B65536").End(xlUp).Row+1,1)
Next
Wb.CloseFalse
EndWith
EndIf
MyName=Dir
Loop
Range("B1").Select
Application.ScreenUpdating=True
MsgBox"共合并了"&Num&"个工作薄下的全部工作表。
如下:
"&Chr(13)&WbN,vbInformation,"提示"
EndSub
步骤阅读
4.然后找到工具栏上面的“运行〞下的“运行子过程/用户窗体〞
步骤阅读
5.合并完成后记得删除宏,详细操作见一
6.删除多余的首行标题:
工作表全选—自动筛选—选择列〔建议选择文本选项少的列〕--勾选重复的标题与空白—删除重复标题与空白
四、多个Excel工作簿的第一个工作表合并成一个新的工作簿
1、将需要合并的excel工作簿文件放置在一个文件夹中。
2、在该文件夹中,新建立一个新的excel工作簿文件。
3、翻开新建立的excel工作簿文件,将鼠标移动到下方工作表名称sheet1上右键,选择查看代码。
4、在弹出的代码编辑窗口中,输入代码。
5、在代码窗口中,粘贴以下代码:
PrivateSub合并工作薄()
Dimf_nameAsString
Dimbok1AsWorkbook,bok2AsWorkbook
Setbok2=Nothing
f_name=Dir(ThisWorkbook.Path&"\*.*")'获得该目录下的所有EXCEL文件
DoWhilef_name<>""'开始执行循环
Iff_name<>ThisWorkbook.NameThen'如果当前的文件不是代码所在文件,执行合并操作
Setbok1=Workbooks.Open(ThisWorkbook.Path&"\"&f_name)'翻开被合并的文件
Ifbok2IsNothingThen'合并后的文件是否存在
bok1.Sheets
(1).Copy'如果合并后的文件不存在,那么创立一个
Setbok2=ActiveWorkbook
Else
bok1.Sheets
(1).CopyBefore:
=bok2.Sheets
(1)'如果合并后的文件存在,那么将被合并文件的第一个工作表复制到合并文件中。
EndIf
bok1.Close'关闭被合并文件
EndIf
f_name=Dir()'获取下一个被合并文件名
Loop
EndSub
6、点击菜单栏运行-运行子过程-用户窗体。
关闭代码输入窗口。
翻开excel工作簿,可以看到下方已经将之前工作簿中的工作表都复制到了这一新建工作簿中。
五、多个Excel工作簿的所有工作表〔非空白〕合并成一个新的工作簿
1、将需要合并的excel工作簿文件放置在一个文件夹中。
2、在该文件夹中,新建立一个新的excel工作簿文件。
3、翻开新建立的excel工作簿文件,将鼠标移动到下方工作表名称sheet1上右键,选择查看代码。
4、在弹出的代码编辑窗口中,输入代码。
5、在代码窗口中,粘贴以下代码:
Sub合并工作薄()
DimPathAsString
DimFileNameAsString
DimLastCellAsRange
DimWkbAsWorkbook
DimWSAsWorksheet
DimThisWBAsString
DimMyDirAsString
MyDir=ThisWorkbook.Path&"\"
'ChDriveLeft(MyDir,1)'findalltheexcelfiles
'ChDirMyDir
'Match=Dir$("")
Application.EnableEvents=False
Application.ScreenUpdating=False
Path=MyDir
FileName=Dir(Path&"\*.xls",vbNormal)
DoUntilFileName=""
IfFileName<>ThisWBThen
SetWkb=Workbooks.Open(FileName:
=Path&"\"&FileName)
SetLastCell=WS.Cells.SpecialCells(xlCellTypeLastCell)
IfLastCell.Value=""AndLastCell.Address=Range("$A$1").AddressThen
Else
WS.CopyAfter:
=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
EndIf
NextWS
Wkb.CloseFalse
EndIf
FileName=Dir()
Loop
Application.EnableEvents=True
Application.ScreenUpdating=True
SetWkb=Nothing
SetLastCell=Nothing
EndSub
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 代码 合并 工作
![提示](https://static.bdocx.com/images/bang_tan.gif)