許多人在工作中會(huì)遇到數(shù)據(jù)表有很多頁，少的有幾十頁，多的可能有幾百頁，然后需要合并到一個(gè)頁面進(jìn)行數(shù)據(jù)分析，如果是一頁復(fù)制粘貼的話就比較麻煩了。以下小編就介紹一下利用excel的宏計(jì)算來解決這個(gè)問題，有需要的朋友可以參考哦。

  1、原始數(shù)據(jù)所在工作簿包含多個(gè)格式相同的工作表，只不過每個(gè)工作表內(nèi)容不同，比如說不同人名的工作表數(shù)據(jù)或者不同部門填寫的數(shù)據(jù)。 

  2、在原始數(shù)據(jù)同目錄下新建一個(gè)工作簿，建立兩個(gè)工作表，名稱分別為“首頁”和“合并匯總表”。 

  3、按Alt+F11進(jìn)入VBA代碼編輯和調(diào)試界面。 

  4、根據(jù)下圖提示，插入一個(gè)模塊。 

  5、將下述代碼粘貼到模塊空白處(代碼小編放到最下方了)： 

  6、在“首頁”工作表中按下圖示范插入一個(gè)窗體控件并指定宏為插入的代碼名稱。 

  7、點(diǎn)擊“首頁”工作表中插入的按鈕，根據(jù)提示，瀏覽到原始數(shù)據(jù)工作簿。 

  8、下一步，用鼠標(biāo)選擇要合并的數(shù)據(jù)范圍。 

  注意：每個(gè)工作表數(shù)據(jù)可能不一樣，比如說有的是10行數(shù)據(jù)，有的是30行數(shù)據(jù)。在這里我們可以用鼠標(biāo)選擇任意工作表的一個(gè)較大范圍，比如說A1:D100，保證比最多行數(shù)的工作表數(shù)據(jù)還多就可以，一會(huì)再刪除空行。

  9、點(diǎn)擊確定按鈕，待代碼運(yùn)行完畢后，所有的數(shù)據(jù)就都合并到了“合并匯總表”中。 

  10、選中全部數(shù)據(jù)區(qū)域，執(zhí)行自動(dòng)篩選。然后選擇其中一個(gè)字段，選擇“空白”和標(biāo)題內(nèi)容。 

  11、然后將篩選出來的無用行鼠標(biāo)右鍵刪除，再刪除A列整列即可 

  代碼如下：

  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 "沒有選擇文件!請(qǐng)重新選擇一個(gè)被合并文件!", vbInformation, "取消"

  Else

  Workbooks.Open Filename:=MyFileName

  Num = ActiveWorkbook.Sheets.Count

  MyName = ActiveWorkbook.Name

  Set DataSource = Application.InputBox(prompt:="請(qǐng)選擇要合并的數(shù)據(jù)區(qū)域：", 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