同一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。