EXCEL多表格合并公式.docx

用宏实现：新建一个工作表，命名后保存到和与合并的n个文件同一个文件文件夹，按 alt + f11,双击工程资源管理器里面的sheet1(sheet1),在右侧的代码区粘贴如下代码。运行。等候一会就ok了。 宏1：合并当前目录下所有工作簿的全部工作表到当前工作表sub 合并当前目录下所有工作簿的全部工作表() 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(a65536).end(xlup).row + 2, 1) = left(myname, len(myname) - 4) for g = 1 to sheets.count wb.sheets(g).usedrange.copy .cells(.range(a65536).end(xlup).row + 1, 1) next wbn = wbn & chr(13) & wb.name wb.close false end with end if myname = dir loop range(a1).select application.screenupdating = true msgbox 共合并了 & num & 个工作薄下的全部工作表。如下： & chr(13) & wbn, vbinformation, 提示 end sub 宏2：多个文件表合到一个文件表的多个sheet中sub combineworkbooks() dim filestoopen, ft dim x as integer application.screenupdating = false on error goto errhandler filestoopen = application.getopenfilename _ (filefilter:=micrsofe excel文件(*.xls), *.xls, _ multiselect:=true, title:=要合并的文件) if typename(filestoopen) = boolean then msgbox 没有选定文件 goto errhandler end if x = 1 while x = ubound(filestoopen) set wk = workbooks.open(filename:=filestoopen(x) wk.sheets().move after:=thisworkbook.sheets _ (thisworkbook.sheets.count) x = x + 1 wend msgbox 合并成功完成！errhandler: msgbox err.description resume errhandlerend sub如何合并格式相同的excel表格青岛经济技术开发区审计局 靳大陆在日常审计中，为了能利用现场审计实施系统（以下简称“ao系统”）对数据进行分析，首先需要将采集的原始数据导入到ao系统中。然而，审计中采集的数据经常会是大量格式相同的excel表格，如果分别将这些表格导入ao系统，则需要耗费大量时间进行重复的导入操作，降低了审计效率。笔者通过计算机审计中级培训以及工余时间自学的计算机相关技术知识，创新思维方式，巧妙利用excel的vba功能，编写程序，实现将大量格式相同的excel表格合并到一个表格中，然后再导入ao系统，进行下一步数据分析。具体合并步骤如下：1.将所有格式相同的excel表格保存到一个文件夹内；2.在文件夹内新建一个excel工作表，命名为“汇总表”；3.打开汇总表，按“ alt + f11”打开vba开发环境，双击工程资源管理器里面的sheet1(sheet1),在右侧的代码区编写如下代码：sub 合并当前目录下所有工作簿的全部工作表()dim mypath, myname, awbnamedim wb as workbook, wbn as stringdim g as longdim num, ini as longapplication.screenupdating = falsemypath = activeworkbook.pathmyname = dir(mypath & & *.xls)awbname = activeworkbook.namenum = 0ini = 0do while myname if myname awbname thenset wb = workbooks.open(mypath & & myname)num = num + 1with workbooks(1).activesheetif ini = 0 thenwb.sheets(1).range(wb.sheets(1).cells(1, 1),wb.sheets(1).cells(1,wb.sheets(1).usedrange.columns.count).copy .cells(1, 1)ini=1end iffor g=1 to sheets.countwb.sheets(g).range(wb.sheets(g).cells(2,1),wb.sheets(g).cells(wb.sheets(g).usedrange.rows.count,wb.sheets(g).usedrange.columns.count).copy .cells(.range(a65536).end(xlup).row+1,1)nextwbn=wbn & chr(13) & wb.namewb.close falseend withend ifmyname=dirlooprange(a1).selectapplication.screenupdating = truemsgbox 共合并了 & num & 个工作薄下的全部工作表。如下： & chr(13) & wbn, vbinformati