同一EXCEL文件合并多个工作表数据到同一工作表
- 格式：doc
- 大小：37.00 KB
- 文档页数：3
文档推荐
-
excel合并多个工作簿中的工作表页数:6
下载文档原格式
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
同一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