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

1、把多個工作簿合并到一個工作簿作為新工作簿的一張表(宏代碼)Sub 合并當(dāng)前目錄下所有工作簿的全部工作表 ()Dim MyPath, MyName, AWbNameDim Wb As Workbook, WbN As StringDim G As LongDim Num As LongDim BOX As StringApplication.ScreenUpdating = FalseMyPath = ActiveWorkbook.PathMyName = Dir(MyPath & "" & "*.xls")AWbName = Active

2、Workbook.NameNum = 0Do While MyName <> ""If MyName <> AWbName ThenSet Wb = Workbooks.Open(MyPath & "" & MyName)Num = Num + 1With Workbooks(1).ActiveSheet.Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)For G = 1 To Sheets.

3、CountWb.Sheets(G).UsedRange.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 & " 個工作薄下的全部工作表。如下： &q

4、uot; & Chr(13) & WbN, vbInformation, " 提示 "End Sub具體操作：在工作簿目錄下新建一工作簿，工具-宏 編輯器 插入模塊-粘貼代碼 =運行excel 如何將一個工作簿中的多個工作表合并到一張工作表上打開你的工作簿 新建一個工作表 在這個工作表的標(biāo)簽上右鍵 查看代碼 你把下面 的代碼復(fù)制到里邊去，然后 上面有個運行 運行子程序就可以了，代碼如下，如果 出現(xiàn) 問題你可以嘗試工具 宏 宏安全性里把那個降低為中或者低再試試Sub 合并當(dāng)前工作簿下的所有工作表 ()Application.ScreenUpdating = F

5、alseFor j = 1 To Sheets.CountIf Sheets(j).Name <> ActiveSheet.Name ThenX = Range("A65536").End(xlUp).Row + 1Sheets(j).UsedRange.Copy Cells(X, 1)End IfNextRange("B1").SelectApplication.ScreenUpdating = TrueMsgBox " 當(dāng)前工作簿下的全部工作表已經(jīng)合并完畢！", vbInformation, " 提示 &qu

6、ot;End Sub把同一工作簿多張工作表合并到同一張工作表1 新建一個工作表放在最左邊， ALT + F11 鍵打開代碼框 -插入-模塊 -復(fù)制以 下代碼ALT + F8 鍵打開，運行該代碼即可Sub 合并 ()For I = 2 To Sheets.Count '如果工作表的第一行都一樣，就把下面 Rows("1" &的 1 改成 2 就好了Sheets(I).Rows("1" & ":" & Sheets(I).Range("A60000").End(xlUp).Row). _

7、Copy Range("A" & Range("A60000").End(xlUp).Row + 1)NextEnd Sub批量將多個 excel 中的多個工作簿合并到一個 excel 中將要合并的excel放到一個文件夾中，在這個目錄中新建一個excel,運行以下代碼As StringAs StringAs RangeAs WorkbookAs WorksheetAs StringSub CombineFiles() Dim pathDim FileNameDim LastCellDim WkbDim WSDim ThisWBDim MyDir

8、 As StringMyDir = ThisWorkbook.path & ""'ChDrive Left(MyDir, 1) 'find all the excel files 'ChDir MyDir'Match = Dir$("")ThisWB = ThisWorkbook.NameApplication.EnableEvents = FalseApplication.ScreenUpdating = Falsepath = MyDirFileName = Dir(path & "*.xls

9、", vbNormal)Do Until FileName = ""If FileName <> ThisWB ThenSet Wkb = Workbooks.Open(FileName:=path & "" & FileName)For Each WS In Wkb.WorksheetsSet LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then ElseWS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) End IfNext WSWkb