excel合并工作簿和工作表的代碼

1、把多個(gè)工作簿合并到一個(gè)工作簿作為新工作簿的一張表（宏代碼）sub 合并當(dāng)前目錄下所有工作簿的全部工作表() 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

2、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) nex

3、t wbn = wbn & chr(13) & wb.name wb.close false end with end if myname = dir loop range(a1).select application.screenupdating = true msgbox 共合并了 & num & 個(gè)工作薄下的全部工作表。如下： & chr(13) & wbn, vbinformation, 提示 end sub 具體操作：在工作簿目錄下新建一工作簿，工具-宏-編輯器-插入模塊-粘貼代碼=運(yùn)行excel如何將一個(gè)工作簿中的多個(gè)工作表合并到一張工作表上打開(kāi)你的工作簿 新建一個(gè)工作表 在這個(gè)工

4、作表的標(biāo)簽上右鍵 查看代碼 你把下面的代碼復(fù)制到里邊去，然后 上面有個(gè)運(yùn)行 運(yùn)行子程序就可以了，代碼如下，如果 出現(xiàn)問(wèn)題你可以嘗試工具 宏 宏安全性里把那個(gè)降低為中或者低再試試sub 合并當(dāng)前工作簿下的所有工作表()application.screenupdating = falsefor j = 1 to sheets.count if sheets(j).name activesheet.name then x = range(a65536).end(xlup).row + 1 sheets(j).usedrange.copy cells(x, 1) end ifnextrange(b1)

5、.selectapplication.screenupdating = truemsgbox 當(dāng)前工作簿下的全部工作表已經(jīng)合并完畢！, vbinformation, 提示end sub把同一工作簿多張工作表合并到同一張工作表1 新建一個(gè)工作表放在最左邊，alt + f11 鍵打開(kāi)代碼框-插入-模塊-復(fù)制以下代碼 alt + f8 鍵打開(kāi)，運(yùn)行該代碼即可sub 合并()for i = 2 to sheets.count如果工作表的第一行都一樣，就把下面 rows(1 & 的1改成2就好了sheets(i).rows(1 & : & sheets(i).range(a60000).end(xlup

6、).row). _copy range(a & range(a60000).end(xlup).row + 1)nextend sub批量將多個(gè)excel中的多個(gè)工作簿合并到一個(gè)excel中將要合并的excel放到一個(gè)文件夾中，在這個(gè)目錄中新建一個(gè)excel,運(yùn)行以下代碼 sub combinefiles() dim path as string dim filename as string dim lastcell as range dim wkb as workbook dim ws as worksheet dim thiswb as string dim mydir as string

7、 mydir = thisworkbook.path & chdrive left(mydir, 1) find all the excel files chdir mydir match = dir$() thiswb = thisworkbook.name application.enableevents = false application.screenupdating = false path = mydir filename = dir(path & *.xls, vbnormal) do until filename = if filename thiswb then set w

8、kb = workbooks.open(filename:=path & & filename) for each ws in wkb.worksheets set lastcell = ws.cells.specialcells(xlcelltypelastcell) if lastcell.value = and lastcell.address = range($a$1).address then else ws.copy after:=thisworkbook.sheets(thisworkbook.sheets.count) end if next ws wkb.close false end if filename