06.29 只要一個鍵，瞬間完成工作表或工作簿的數據合併彙總，新手必會！

一、一個工作簿中所有表格的合併

代碼1

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 "當前工作簿下的全部工作表已經合併完畢！", vbInformation, "提示"

End Sub

代碼2

Sub 工作表合併()

For Each st In Worksheets

If st.Name <> ActiveSheet.Name Then st.UsedRange.Offset(1, 0).Copy [a65536].End(xlUp).Offset(1, 0)

Next

End Sub

基本方法

1、先建立各個要合併的數據表，要求格式相同

2、建立一個空的彙總表

3、開發工具--錄製宏--馬上停止錄製

“宏”--選擇剛錄製的宏--編輯--刪除全部數據--複製代碼1或代碼2到編輯框

保存，運行一下看看

完成

二、同一文件夾內所有工作簿的彙總

打開彙總表，輸入下面代碼

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 & "\\" & "*.xls")

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

運行後

怎麼樣？ 學會了嗎，是不是超實用，不會的關注我，我給你發模板！