前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >VBA: 将多个工作簿的第一张工作表合并到一个工作簿中

VBA: 将多个工作簿的第一张工作表合并到一个工作簿中

作者头像
Exploring
发布2022-09-20 14:49:15
5.8K0
发布2022-09-20 14:49:15
举报
文章被收录于专栏:数据处理与编程实践

文章背景: 在工作中,有时需要将多个工作簿进行合并,比如将多份原始数据附在报告之后。一般的操作方法是打开两个工作簿(目标工作簿和待转移的工作簿),然后选中需要移动的工作表,右键单击以后选择“移动或复制”。接下来在新的对话框里面进行设置。

这种方法适合在移动少量工作表的时候使用。如果有很多的工作簿,都需要进行移动的话,一个一个打开然后再操作比较费时费力。这时就可以使用VBA来批量进行操作。

在目标工作簿内,插入一个模块,然后导入如下的代码:

代码语言:javascript
复制
Option Explicit

Sub MergeWorkbook()

    '将多个工作簿的第一张工作表合并到目标工作簿中
    
    Dim folder_path As String, filename As String
    
    Dim first_sheet As Worksheet, wb As Workbook, ii As Integer
    
    Dim temp_name As String

    '关闭屏幕刷新
    Application.ScreenUpdating = False
    
    '当前文件夹的路径
    folder_path = ThisWorkbook.path
    
    filename = Dir(folder_path & "\*.xls*")
    
    While filename <> ""
    
        If filename <> ThisWorkbook.Name Then
        
            Set wb = Workbooks.Open(folder_path & "\" & filename)
            
            temp_name = Left(wb.Name, InStr(wb.Name, ".") - 1)  '工作簿名称,不包含文件拓展名
            
            Set first_sheet = ActiveWorkbook.Worksheets(1)
            
            ii = ThisWorkbook.Sheets.Count
            first_sheet.Copy After:=ThisWorkbook.Sheets(ii)
            
            ActiveSheet.Name = temp_name
                
            wb.Close
        
        End If
        
        filename = Dir
        
    Wend
    
    '恢复屏幕刷新
    Application.ScreenUpdating = True
    
    MsgBox "Done!"
    
End Sub

(1) 将目标工作簿和待转移的工作簿放在同一个文件夹内;

(2)上述代码要实现的功能是,将同一个文件夹内所有工作簿(目标工作簿除外)的第一张工作表拷贝到目标工作簿内,并将表名设置为拷贝前所属的工作簿名称。

转移前:

转移后:

参考资料:

[1] 如何使用Excel VBA将多个工作簿的全部工作表合并到一个工作簿中(https://zhuanlan.zhihu.com/p/76786888

本文参与 腾讯云自媒体同步曝光计划,分享自微信公众号。
原始发表:2022-07-20,如有侵权请联系 cloudcommunity@tencent.com 删除

本文分享自 数据处理与编程实践 微信公众号,前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体同步曝光计划  ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档