時不時就有同學在問，一個工作簿中每天一份報表，一個月下來30份報表需要匯總成一張表，復制粘貼來的比較慢，還有的是有很多個格式一樣的表位于不同的工作簿中，需要合并到一個工作表里，等等……

你可以到本公眾號后臺回復excel擴展，去下載小工具，里面有多表合并功能，也可以利用數(shù)據(jù)查詢功能合并。

今天我們來講講利用VBA實現(xiàn)多表合并的技巧，大家可以把代碼收藏好，使用的時候非常的方便。

上邊動圖中有1、2、3、4，4個sheet，分別是不同部門的人員信息，需要合并到匯總sheet里。

步驟：

右鍵點擊匯總sheet表名，查看代碼，把代碼復制進去，點擊運行，很快就可以看到合并后的結果了。

代碼如下：

Sub 合并當前工作簿下的所有工作表()

Application.ScreenUpdating = False

For 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 If

Next

Range('B1').Select

Application.ScreenUpdating = True

MsgBox '當前工作簿下的全部工作表已經(jīng)合并完畢！', vbInformation, '提示'

End Sub

大家仔細觀察，工作簿1中有兩個sheet，合并的時候都會合并進去。

代碼如下：

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

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 & '\' & '*.xlsx')

AWbName = ActiveWorkbook.Name

Num = 0

Do While MyName <> ''

If MyName <> AWbName Then

Set Wb = Workbooks.Open(MyPath & '\' & MyName)

Num = Num 1

With Workbooks(1).ActiveSheet

.Cells(.Range('B65536').End(xlUp).Row 2, 1) = Left(MyName, Len(MyName) - 4)

For G = 1 To Sheets.Count

Wb.Sheets(G).UsedRange.Copy .Cells(.Range('B65536').End(xlUp).Row 1, 1)

Next

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

Wb.Close False

End With

End If

MyName = Dir

Loop

Range('B1').Select

Application.ScreenUpdating = True

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

End Sub

注意代碼紅色字體部分，根據(jù)自己的版本更改。

多個工作簿中的表合并到一個工作簿中，不進行匯總，只是放到一個工作簿，保留原來的表名。

代碼如下：

Sub 匯總數(shù)據(jù)()

Application.ScreenUpdating = False

 Dim wb, wb1 As Excel.Workbook

Dim sh As Excel.Worksheet

s = Split(ThisWorkbook.Name, '.')(1)

f = Dir(ThisWorkbook.Path & '\*' & s) '生成查找EXCEL的目錄

Do While f <> '' '在目錄中循環(huán)

If f <> ThisWorkbook.Name Then  '如果不是打開的工作簿

Set wb = Workbooks.Open(ThisWorkbook.Path & '\' & f)

wb.Worksheets('sheet1').Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

ActiveSheet.Name = Split(wb.Name, '.')(0)

    wb.Close

    End If

    f = Dir

    Loop

ThisWorkbook.Worksheets('匯總').Activate

    Application.ScreenUpdating = True

End Sub

三種情況下的合并全在此了，不需要懂得VBA，只要復制上面代碼運行下就OK了，方便吧！