命令從下面第一個(gè)Sub開(kāi)始：

Sub 合并當(dāng)前目錄下所有工作簿的全部工作表()

Dim MyPath, MyName, AWbNameDim Wb As Workbook, WbN As StringDim G As Long, k As IntegerDim Num As LongDim BOX As StringApplication.ScreenUpdating = FalseMyPath = ActiveWorkbook.PathMyName = Dir(MyPath & "\" & "*.xls")AWbName = ActiveWorkbook.NameNum = 0ii = 0Do While MyName <> ""If MyName <> AWbName ThenSet Wb = Workbooks.Open(MyPath & "\" & MyName)Num = Num + 1With Workbooks(1).ActiveSheet.Cells(.Range("B" & Rows.Count).End(xlUp).Row + 1, 1) = Left(MyName, Len(MyName) - 4)For G = 1 To Sheets.Countk = k + 1If k = 1 Then '如果第一次復(fù)制，被復(fù)制文件就進(jìn)行復(fù)制前面幾行標(biāo)題欄Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B" & Rows.Count).End(xlUp).Row, 2) '1是從第一列開(kāi)始黏貼If .Range("B" & Rows.Count).End(xlUp).Row > 100000 ThenMsgBox "如下表格錯(cuò)誤，超過(guò)一萬(wàn)行" & Chr(13) & Wb.NameEnd Ifii = .Range("B" & Rows.Count).End(xlUp).RowElse '否則就下移三行（假設(shè)標(biāo)題欄三行） .下行代碼中的Offset(3) 就是下移三行再?gòu)?fù)制，所以要下移幾行改這個(gè)3為幾就可以了Wb.Sheets(G).UsedRange.Offset(1).Copy .Cells(.Range("B" & Rows.Count).End(xlUp).Row + 1, 2) '+1是從有數(shù)行的下一行開(kāi)始黏貼If .Range("B" & Rows.Count).End(xlUp).Row > (ii + 100000) ThenMsgBox "如下表格錯(cuò)誤，超過(guò)一萬(wàn)行" & Chr(13) & Wb.NameEnd Ifii = .Range("B" & Rows.Count).End(xlUp).RowEnd IfNextWbN = WbN & Chr(13) & Wb.NameWb.Close FalseEnd WithEnd IfMyName = DirLoopRange("B1").SelectApplication.ScreenUpdating = TrueMsgBox "共合并了" & Num & "個(gè)工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"

End Sub

總結(jié)

以上是生活随笔為你收集整理的Excel VBA合并不同工作簿所有工作表到一张工作表的全部?jī)?nèi)容，希望文章能夠幫你解決所遇到的問(wèn)題。

如果覺(jué)得生活随笔網(wǎng)站內(nèi)容還不錯(cuò)，歡迎將生活随笔推薦給好友。