云题海 - 专业文章范例文档资料分享平台

当前位置:首页 > excel如何把多张工作表内容快速复制到一张表

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

  • 62 次阅读
  • 3 次下载
  • 2025/6/3 12:59:48

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

  • 收藏
  • 违规举报
  • 版权认领
下载文档10.00 元 加入VIP免费下载
推荐下载
本文作者:...

共分享92篇相关文档

文档简介:

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 <

× 游客快捷下载通道(下载后可以自由复制和排版)
单篇付费下载
限时特价:10 元/份 原价:20元
VIP包月下载
特价:29 元/月 原价:99元
低至 0.3 元/份 每月下载150
全站内容免费自由复制
VIP包月下载
特价:29 元/月 原价:99元
低至 0.3 元/份 每月下载150
全站内容免费自由复制
注:下载文档有可能“只有目录或者内容不全”等情况,请下载之前注意辨别,如果您已付费且无法下载或内容有问题,请联系我们协助你处理。
微信:fanwen365 QQ:370150219
Copyright © 云题海 All Rights Reserved. 苏ICP备16052595号-3 网站地图 客服QQ:370150219 邮箱:370150219@qq.com