同一EXCEL文件合并多个工作表数据到同一工作表

同一EXCEL文件合并多个工作表数据到同一工作

表

首先，添加通用函数

1．打开VBE。

2．单击“插入——模块”，添加一个新模块。

3．在模块窗口，输入下面的代码。

Function LastRow(sh As Worksheet)

On Error Resume Next

LastRow = sh.Cells.Find(what:="*", _

After:=sh.Range("A1"), _ Lookat:=xlPart, _

LookIn:=xlFormulas, _

SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _

MatchCase:=False).Row On Error GoTo 0

End Function

Function LastCol(sh As Worksheet)

On Error Resume Next

LastCol = sh.Cells.Find(what:="*", _

After:=sh.Range("A1"), _ Lookat:=xlPart, _

LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _

SearchDirection:=xlPrevious, _

MatchCase:=False).Column On Error GoTo 0

End Function

这两个函数分别用于查找工作表中包含数据的最后一行和最后一列。

下面，我们将复制工作簿中所有工作表的数据，并将这些数据合并到一个汇总工作表中。

复制多个工作表中的所有数据

1． 在模块窗口输入下列代码后，运行即可。

Sub合并工作表()

Dim sh As Worksheet

Dim DestSh As Worksheet

Dim Last As Long

Dim CopyRng As Range

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

'如果工作表"RDBMergeSheet"存在则将其删除

Application.DisplayAlerts = False

On Error Resume Next

ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0

Application.DisplayAlerts = True

'添加一个名为"RDBMergeSheet"的工作表

Set DestSh = ActiveWorkbook.Worksheets.Add

= "RDBMergeSheet"

'遍历所有工作表并将数据复制到DestSh

For Each sh In ActiveWorkbook.Worksheets

If <> Then

'找到在工作表DestSh中带有数据的最后一行

Last = LastRow(DestSh)

'设置希望复制的单元格区域

Set CopyRng=edRange

'测试工作表DestSh中是否有足够的行用来复制所有数据

If Last + CopyRng.Rows.Count >

DestSh.Rows.Count Then

MsgBox "在工作表Destsh中没有足够的行用来放置数据!"

GoTo ExitTheSub

End If

'下面的语句从每个工作表中复制值和格式

CopyRng.Copy

With DestSh.Cells(Last + 1, "A")

.PasteSpecial xlPasteValues

.PasteSpecial xlPasteFormats

Application.CutCopyMode = False

End With

'可选代码: 下面的语句复制工作表名称到H列

DestSh.Cells(Last + 1,

"H").Resize(CopyRng.Rows.Count).Value = End If

Next

ExitTheSub:

Application.GoTo DestSh.Cells(1)

'自动调整DestSh工作表的列宽

DestSh.Columns.AutoFit

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub