xlsx表格怎么做汇总统计_excel怎么快速合并多个工作表数据到一个工作表

将下述代码粘贴到模块空白处：

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