導讀頭條號名稱親愛的讀者，Excel愛好者：大家新年好！在實際工作中，我們是否經(jīng)常遇到許多的工作簿需要合并在一起的情形呢？我想答案是肯定的。特別是大量工作表的內(nèi)....

頭條號名稱

親愛的讀者，Excel愛好者：

大家新年好！

在實際工作中，我們是否經(jīng)常遇到許多的工作簿需要合并在一起的情形呢？

我想答案是肯定的。特別是大量工作表的內(nèi)容結(jié)構(gòu)十分相似的情況下，這就需要我們對其做合并工作，以便我們進行統(tǒng)計工作。

要是工作表張數(shù)不多的情況下（3-5張工作表），我們可以用復(fù)制一張工作表，再把它粘貼到一新的工作表中。問題關(guān)鍵是如果工作表張數(shù)特別多，甚至數(shù)百上千張工作表的情況下呢，這種復(fù)制粘貼的老法子是不是非常的恐怖呢？

朋友們，讀者們，不用害怕！

現(xiàn)在就和大家分享一種超級使用，快速合并工作表的方法。

代碼如下：

Sub CombineWbs()

Dim bt As Range, r As Long, c As Long

r = 1

c = 7

Dim wt As Worksheet

Set wt = ThisWorkbook.Worksheets(1)

wt.Rows(r 1 & ":1048576").ClearContents

Application.ScreenUpdating = False

Dim FileName As String, sht As Worksheet, wb As Workbook, WbN As String

Dim Erow As Long, fn As String, arr As Variant, Num As Long

FileName = Dir(ThisWorkbook.Path & "*.xlsx")

Num = 0

Do While FileName <> ""

If FileName <> ThisWorkbook.Name Then

Erow = wt.Range("A1").CurrentRegion.Rows.Count 1

fn = ThisWorkbook.Path & "" & FileName

Set wb = GetObject(fn)

Set sht = wb.Worksheets(1)

Num = Num 1

arr = sht.Range(sht.Cells(r 1, "A"), sht.Cells(1048576, "B").End(xlUp).Offset(0, 7))

wt.Cells(Erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr

WbN = WbN & Chr(13) & wb.Name

wb.Close False

End If

FileName = Dir

Loop

Application.ScreenUpdating = True

MsgBox "共合并了" & Num & "個工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"

End Sub

以上代碼，只要復(fù)制粘貼到Excel開發(fā)工具下的工程編輯窗口下，然后點擊運行按鈕，就可以快速實現(xiàn)上述功能了。

如果喜歡這篇文章，請點贊。如果有好的建議，請發(fā)表評論。

謝謝大家寶貴的時間！！

溫馨提示：（1）需要合并的工作簿和執(zhí)行合并的活動工作簿，二者必須在同一文件夾下；

（2）需要合并的工作表內(nèi)容及結(jié)構(gòu)相似。