操作步驟：

1、原始資料所在工作簿包含多個格式相同的工作表，只不過每個工作表內容不同，比如說不同人名的工作表資料或者不同部門填寫的資料。

2、在原始資料同目錄下新建一個工作簿，建立兩個工作表，名稱分別為“首頁”和“合併彙總表”。

3、按Alt+F11進入VBA程式碼編輯和除錯介面。

4、根據下圖提示，插入一個模組。

5、將下述程式碼貼上到模組空白處：

複製程式碼

程式碼如下:Sub CombineSheetsCells()

Dim wsNewWorksheet As Worksheet

Dim cel As Range

Dim DataSource, RowTitle, ColumnTitle, SourceDataRows, SourceDataColumns As Variant

Dim TitleRow, TitleColumn As Range

Dim Num As Integer

Dim DataRows As Long

DataRows = 1

Dim TitleArr()

Dim Choice

Dim MyName$, MyFileName$, ActiveSheetName$, AddressAll$, AddressRow$, AddressColumn$, FileDir$, DataSheet$, myDelimiter$

Dim n, i

n = 1

i = 1

Application.DisplayAlerts = False

Worksheets("合併彙總表").Delete

Set wsNewWorksheet = Worksheets.Add(, after:=Worksheets(Worksheets.Count))

wsNewWorksheet.Name = "合併彙總表"

MyFileName = Application.GetOpenFilename("Excel工作薄 (*.xls*),*.xls*")

If MyFileName = "False" Then

MsgBox "沒有選擇檔案！請重新選擇一個被合併檔案！", vbInformation, "取消"

Else

Workbooks.Open Filename:=MyFileName

Num = ActiveWorkbook.Sheets.Count

MyName = ActiveWorkbook.Name

Set DataSource = Application.InputBox(prompt:="請選擇要合併的資料區域：", Type:=8)

AddressAll = DataSource.Address

ActiveWorkbook.ActiveSheet.Range(AddressAll).Select

SourceDataRows = Selection.Rows.Count

SourceDataColumns = Selection.Columns.Count

Application.ScreenUpdating = False

Application.EnableEvents = False

For i = 1 To Num

ActiveWorkbook.Sheets(i).Activate

ActiveWorkbook.Sheets(i).Range(AddressAll).Select

Selection.Copy

ActiveSheetName = ActiveWorkbook.ActiveSheet.Name

Workbooks(ThisWorkbook.Name).Activate

ActiveWorkbook.Sheets("合併彙總表").Select

ActiveWorkbook.Sheets("合併彙總表").Range("A" & DataRows).Value = ActiveSheetName

ActiveWorkbook.Sheets("合併彙總表").Range(Cells(DataRows, 2), Cells(DataRows, 2)).Select

Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

DataRows = DataRows + SourceDataRows

Workbooks(MyName).Activate

Next i

Application.ScreenUpdating = True

Application.EnableEvents = True

End If

Workbooks(MyName).Close

End Sub

6、在“首頁”工作表中按下圖示範插入一個窗體控制元件並指定宏為插入的程式碼名稱。

8、下一步，用滑鼠選擇要合併的資料範圍。

注意：

1）A列的文字說明右側的資料來自於原始資料表的哪個工作表；

10、選中全部資料區域，執行自動篩選。然後選擇其中一個欄位，選擇“空白”和標題內容。