宏代码合并工作表.docx

上传人:b****1 文档编号:11171528 上传时间:2023-05-29 格式:DOCX 页数:13 大小:648.95KB
下载 相关 举报
宏代码合并工作表.docx_第1页
第1页 / 共13页
宏代码合并工作表.docx_第2页
第2页 / 共13页
宏代码合并工作表.docx_第3页
第3页 / 共13页
宏代码合并工作表.docx_第4页
第4页 / 共13页
宏代码合并工作表.docx_第5页
第5页 / 共13页
宏代码合并工作表.docx_第6页
第6页 / 共13页
宏代码合并工作表.docx_第7页
第7页 / 共13页
宏代码合并工作表.docx_第8页
第8页 / 共13页
宏代码合并工作表.docx_第9页
第9页 / 共13页
宏代码合并工作表.docx_第10页
第10页 / 共13页
宏代码合并工作表.docx_第11页
第11页 / 共13页
宏代码合并工作表.docx_第12页
第12页 / 共13页
宏代码合并工作表.docx_第13页
第13页 / 共13页
亲,该文档总共13页,全部预览完了,如果喜欢就下载吧!
下载资源
资源描述

宏代码合并工作表.docx

《宏代码合并工作表.docx》由会员分享,可在线阅读,更多相关《宏代码合并工作表.docx(13页珍藏版)》请在冰点文库上搜索。

宏代码合并工作表.docx

宏代码合并工作表

宏代码—工作表合并

一、关于宏的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

展开阅读全文
相关资源
猜你喜欢
相关搜索

当前位置:首页 > 法律文书 > 调解书

copyright@ 2008-2023 冰点文库 网站版权所有

经营许可证编号:鄂ICP备19020893号-2