宏代碼-合并工作表

宏代碼—工作表合并一、關(guān)于宏的EXCEL設(shè)置1.設(shè)置快捷宏圖標(biāo)：文件—EXCEL選項(xiàng)-常用-在功能區(qū)顯示“開發(fā)工具〞選項(xiàng)卡打鉤2.刪除宏：宏-選中相應(yīng)的宏-刪除3.取消出現(xiàn)平安隱私警告：EXCEL選項(xiàng)-信任中心-信任中心設(shè)置-個(gè)人信息選項(xiàng)-將〞保存時(shí)從文件屬性中刪除個(gè)人信息“前面的勾去掉二、合并當(dāng)前工作簿下的所有工作表1.我們現(xiàn)在開始合并，首先要在最前頁新建一個(gè)工作表。如圖：2.在新建的sheet表中“右鍵〞，找到“查看代碼〞，然后看到宏計(jì)算界面。如下圖：看到宏計(jì)算界面，我們就只需要把下面的代碼復(fù)制進(jìn)去，代碼如下，效果如下：Sub合并當(dāng)前工作簿下的所有工作表()Application.ScreenUpdating=FalseForj=1ToSheets.Count

IfSheets(j).Name<>ActiveSheet.NameThen

X=Range("A65536").End(xlUp).Row+1

Sheets(j).UsedRange.CopyCells(X,1)

EndIfNextRange("B1").SelectApplication.ScreenUpdating=TrueMsgBox"當(dāng)前工作簿下的全部工作表已經(jīng)合并完畢！",vbInformation,"提示"EndSub或者如下：Sub

合并()

For

I

=

2

To

Sheets.Count

'如果工作表的第一行都一樣，就把下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

Sub53.點(diǎn)擊工具欄上面的“運(yùn)行〞下的“運(yùn)行子過程/用戶窗體〞就可以了，合并完之后會(huì)有提示。提示完成之后就可以把宏計(jì)算界面關(guān)閉了。如下圖：4.合并完成后記得刪除宏，詳細(xì)操作見一5.刪除多余的首行標(biāo)題：工作表全選—自動(dòng)篩選—選擇列〔建議選擇文本選項(xiàng)少的列〕--勾選重復(fù)的標(biāo)題與空白—?jiǎng)h除重復(fù)標(biāo)題與空白三、合并當(dāng)前目錄下所有工作簿的全部工作表1.我們需要把多個(gè)excel表都放在同一個(gè)文件夾里面，并在這個(gè)文件夾里面新建一個(gè)excel。如下圖：2.用microsoftexcel翻開新建的excel表，并右鍵單擊sheet1，找到“查看代碼〞，單擊進(jìn)去。進(jìn)去之后就看到了宏計(jì)算界面。如下圖：3.然后我們把下面這些宏計(jì)算的代碼復(fù)制進(jìn)去〔注意XLS或者XLSX〕，代碼如下，如下圖：Sub合并當(dāng)前目錄下所有工作簿的全部工作表()DimMyPath,MyName,AWbNameDimWbAsWorkbook,WbNAsStringDimGAsLongDimNumAsLongDimBOXAsStringApplication.ScreenUpdating=FalseMyPath=ActiveWorkbook.PathMyName=Dir(MyPath&"\"&"*.xls")AWbName=ActiveWorkbook.NameNum=0DoWhileMyName<>""IfMyName<>AWbNameThenSetWb=Workbooks.Open(MyPath&"\"&MyName)Num=Num+1WithWorkbooks(1).ActiveSheet.Cells(.Range("B65536").End(xlUp).Row+2,1)=Left(MyName,Len(MyName)-4)ForG=1ToSheets.CountWb.Sheets(G).UsedRange.Copy.Cells(.Range("B65536").End(xlUp).Row+1,1)NextWbN=WbN&Chr(13)&Wb.NameWb.CloseFalseEndWithEndIfMyName=DirLoopRange("B1").SelectApplication.ScreenUpdating=TrueMsgBox"共合并了"&Num&"個(gè)工作薄下的全部工作表。如下："&Chr(13)&WbN,vbInformation,"提示"EndSub4.然后找到工具欄上面的“運(yùn)行〞下的“運(yùn)行子過程/用戶窗體〞5.合并完成后記得刪除宏，詳細(xì)操作見一6.刪除多余的首行標(biāo)題：工作表全選—自動(dòng)篩選—選擇列〔建議選擇文本選項(xiàng)少的列〕--勾選重復(fù)的標(biāo)題與空白—?jiǎng)h除重復(fù)標(biāo)題與空白四、多個(gè)Excel工作簿的第一個(gè)工作表合并成一個(gè)新的工作簿1、將需要合并的excel工作簿文件放置在一個(gè)文件夾中。2、在該文件夾中，新建立一個(gè)新的excel工作簿文件。3、翻開新建立的excel工作簿文件，將鼠標(biāo)移動(dòng)到下方工作表名稱sheet1上右鍵，選擇查看代碼。4、在彈出的代碼編輯窗口中，輸入代碼。5、在代碼窗口中，粘貼以下代碼：PrivateSub合并工作薄()Dimf_nameAsStringDimbok1AsWorkbook,bok2AsWorkbookSetbok2=Nothingf_name=Dir(ThisWorkbook.Path&"\*.*")'獲得該目錄下的所有EXCEL文件DoWhilef_name<>""'開始執(zhí)行循環(huán)Iff_name<>ThisWorkbook.NameThen'如果當(dāng)前的文件不是代碼所在文件，執(zhí)行合并操作Setbok1=Workbooks.Open(ThisWorkbook.Path&"\"&f_name)'翻開被合并的文件Ifbok2IsNothingThen'合并后的文件是否存在bok1.Sheets(1).Copy'如果合并后的文件不存在，那么創(chuàng)立一個(gè)Setbok2=ActiveWorkbookElsebok1.Sheets(1).CopyBefore:=bok2.Sheets(1)'如果合并后的文件存在，那么將被合并文件的第一個(gè)工作表復(fù)制到合并文件中。EndIfbok1.Close'關(guān)閉被合并文件EndIff_name=Dir()'獲取下一個(gè)被合并文件名LoopEndSub6、點(diǎn)擊菜單欄運(yùn)行-運(yùn)行子過程-用戶窗體。關(guān)閉代碼輸入窗口。翻開excel工作簿，可以看到下方已經(jīng)將之前工作簿中的工作表都復(fù)制到了這一新建工作簿中。五、多個(gè)Excel工作簿的所有工作表〔非空白〕合并成一個(gè)新的工作簿1、將需要合并的excel工作簿文件放置在一個(gè)文件夾中。2、在該文件夾中，新建立一個(gè)新的excel工作簿文件。3、翻開新建立的excel工作簿文件，將鼠標(biāo)移動(dòng)到下方工作表名稱sheet1上右鍵，選擇查看代碼。4、在彈出的代碼編輯窗口中，輸入代碼。5、在代碼窗口中，粘貼以下代碼：Sub合并工作薄()DimPathAsStringDimFileNameAsStringDimLastCellAsRangeDimWkbAsWorkbookDimWSAsWorksheetDimThisWBAsStringDimMyDirAsStringMyDir=ThisWorkbook.Path&"\"'ChDriveLeft(MyDir,1)'findalltheexcelfiles'ChDirMyDir'Match=Dir$("")ThisWB=ThisWorkbook.NameApplication.EnableEvents=FalseApplication.ScreenUpdating=FalsePath=MyDirFileName=Dir(Path&"\*.xls",vbNormal)DoUntilFileName=""IfFileName<>ThisWBThenSetWkb=Workbooks.Open(FileName:=Path&"\"&FileName)ForEachWSInWkb.WorksheetsSetLastCell=WS.Cells.SpecialCells(xlCellTypeLastCell)IfLastCell.Value=""AndLastCell.Address=Range("$A$1").AddressThenElseWS.CopyAfter:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)