如何在EXCEL文件中把一个工作簿中的所有工作表数据汇总，表格内容全部一样。

Question

如题所述

Answer 1

在Excel中将一个工作簿中的所有工作表数据汇总，可以使用VBA代码来实现。首先，打开VBA编辑器，通过Alt+F11快捷键打开，然后将下面的代码粘贴到编辑器中。

该代码会提示用户是否有表头，选择“是”或“否”后，将开始汇总操作。保存文件后，通过Alt+F8快捷键选择执行宏。如果需要现成的文件，可以留下联系邮箱，发送给您。

宏定义如下：

Sub Combine_data()

Dim source, target As String

Dim s As Worksheet

Dim tr As Double

Dim SheetHeader As String

OpenFN = Workbooks.Application.GetOpenFilename

If OpenFN = False Then Exit Sub

Workbooks.Open OpenFN

SheetHeader = MsgBox("是否有表头？", vbYesNo)

Application.ScreenUpdating = False

source = ActiveWorkbook.Name

Workbooks.Add

target = ActiveWorkbook.Name

If SheetHeader = vbYes Then

RowStart = 2

tr = 2

Windows(source).Activate

Rows("1:1").Select

Selection.Copy

Windows(target).Activate

Range("A" & 1).Select

ActiveSheet.Paste

ElseIf SheetHeader = vbNo Then

RowStart = 1

tr = 1

End If

Windows(source).Activate

For Each s In ActiveWorkbook.Sheets

Sheets(s.Name).Select

lr = LastCell(ActiveSheet).Row

Rows(RowStart & ":" & lr).Select

Selection.Copy

Windows(target).Activate

Range("A" & tr).Select

ActiveSheet.Paste

If SheetHeader = vbYes Then

tr = tr + lr - 1

ElseIf SheetHeader = vbNo Then

tr = tr + lr

End If

Windows(source).Activate

Next

Application.DisplayAlerts = False

Workbooks(source).Close savechanges:=False

' Application.CutCopyMode = False

Application.ScreenUpdating = True

MsgBox "合并完成！"

End Sub

Function LastCell(ws As Worksheet) As Range

Dim LastRow&, LastCol%

On Error Resume Next

With ws

' Find the last real row

LastRow& = .Cells.Find(What:="*",

SearchDirection:=xlPrevious,

SearchOrder:=xlByRows).Row

' Find the last real column

LastCol% = .Cells.Find(What:="*",

SearchDirection:=xlPrevious,

SearchOrder:=xlByColumns).Column

End With

Set LastCell = ws.Cells(LastRow&, LastCol%)

End Function

这段代码能够高效地汇总多个工作表的数据，您可以根据需要调整代码来适应不同的需求。