第一范文网 - 专业文章范例文档资料分享平台

excel如何把多张工作表内容快速复制到一张表

来源:用户分享 时间:2025/5/29 7:11:18 本文由loading 分享 下载这篇文档手机版
说明:文章内容仅供预览,部分内容可能不全,需要完整文档或者需要复制内容,请下载word后使用。下载word有问题请添加微信号:xxxxxxx或QQ:xxxxxx 处理(尽可能给您提供完整文档),感谢您的支持与谅解。

End Sub 修改“开始行号”。

将光标定位到代码中间任意位置,按F5运行它。 关闭VBE窗口。注意单词之间要用空格隔开。

Excel多个工作簿中的工作表合并到一个工作簿中

有时,需要将多个Excel工作簿中的工作表合并到一个工作簿中。有多种合并工作簿的情形,下面先给出一种合并多个工作簿的VBA范例,供参考。(此方法将一个工作簿中所有的工作表复制到一张工作表上)

方法1

Sub CombineWorkbooks() Dim wk As Workbook Dim sh As Worksheet Dim strFileName As String Dim strFileDir As String Dim nm As String

nm = ThisWorkbook.Name

strFileDir = ThisWorkbook.path & \Application.ScreenUpdating = False strFileName = Dir(strFileDir & \Do While strFileName <> vbNullString If strFileName <> nm Then MsgBox strFileName

Set wk = Workbooks.Open(Filename:=strFileDir & strFileName, ReadOnly:=True) strFileName = Left(Left(strFileName, Len(strFileName) - 4), 29) '取主文件名,除掉.XLS

For Each sh In wk.Sheets

sh.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) '工作表命名,以工作表所在文件名为类 If wk.Sheets.Count > 1 Then

ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = strFileName & sh.Name Else

ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = strFileName End If Next

wk.Close SaveChanges:=False End If

strFileName = Dir Loop

Application.ScreenUpdating = True End Sub 方法2

Sub UnWorksheets()

Application.ScreenUpdating = False Dim lj As String Dim dirname As String Dim nm As String Dim sname As String

Dim i As Integer, ii As Integer lj = ActiveWorkbook.path nm = ActiveWorkbook.Name dirname = Dir(lj & \查找文件 Do While dirname <> \If dirname <> nm Then

Workbooks.Open Filename:=lj & \打开文件 ii = ActiveWorkbook.Sheets.Count '统计工作表个数

'复制新打开工作簿的每一个工作表到当前工作表

(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))最后一个后面 For i = 1 To ii

Workbooks(dirname).Sheets(i).Copy

After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) Next

Workbooks(dirname).Close False End If

dirname = Dir Loop End Sub

在同一文件夹下有多个工作簿,其中有一个用于汇总的工作簿,将除该汇总工作簿外的其它工作簿中的每一张工作表的数据汇总到该汇总工作簿的一张工作表中。好用!

Sub UnionWorksheets()

Application.ScreenUpdating = False’关闭屏幕更新 Dim lj As String Dim dirname As String Dim nm As String

Dim i As Integer, ii As Integer

lj = ActiveWorkbook.path’ Path 属性。返回指定文件、文件夹、或驱动器的路径。

nm = ActiveWorkbook.Name’ Name属性。指定一个控件或对象的名称或与 Font 对象相关的字体的名称。变量赋值使

用=“等号”,“=”后的值可以是单纯的数值、字符串或表达式。

dirname = Dir(lj & \’ Dir 函数。返回一个String,用以表示一个文件名、目录名或文件夹名称,它必须与指定的模式或文件属性、或磁盘卷标相匹配。

Cells.Clear’ Clear 方法。清除 Err 对象的所有属性设置。 Do While dirname <> \’前置式DO?LOOP循环。 If dirname <> nm Then

Workbooks.Open Filename:=lj & \’ Open 方

法。“<>”为比较运算符“不等于”。

ii = ActiveWorkbook.Sheets.Count’ Sheets 属性

Workbooks(nm).Activate’ Activate方法。Workbooks(nm)属使用工作簿

名称引用workbook,语法格式为:workbook( 工作簿名称)。

'复制新打开工作簿的每一个工作表的已用区域到当前工作表 For i = 1 To ii

Workbooks(dirname).Sheets(i).UsedRange.Copy _ Range(\’ UsedRange 属性。返

回代表指定工作表上已使用区域的 Range 对象。只读

Next

excel如何把多张工作表内容快速复制到一张表.doc 将本文的Word文档下载到电脑,方便复制、编辑、收藏和打印
本文链接:https://www.diyifanwen.net/c4md7x47x771emx02t1je_3.html(转载请注明文章来源)
热门推荐
Copyright © 2012-2023 第一范文网 版权所有 免责声明 | 联系我们
声明 :本网站尊重并保护知识产权,根据《信息网络传播权保护条例》,如果我们转载的作品侵犯了您的权利,请在一个月内通知我们,我们会及时删除。
客服QQ:xxxxxx 邮箱:xxxxxx@qq.com
渝ICP备2023013149号
Top