使用VBA合并多个Excel工作簿

最新推荐文章于 2024-08-18 19:08:19 发布

zwjsatan

最新推荐文章于 2024-08-18 19:08:19 发布

阅读量4k

点赞数

分类专栏：基础知识文章标签：工作 excel vba string object each

本文链接：https://blog.csdn.net/zwjsatan/article/details/4856497

版权

基础知识专栏收录该内容

5 篇文章 0 订阅

订阅专栏

有许多实现Excel工作簿合并的方法，在《将多个工作簿中的数据合并到一个工作簿》中介绍过合并工作簿的示例。下面再列举几个示例，供有兴趣的朋友参考。

例如，需要将多个Excel工作簿中的工作表合并到一个工作簿。这里假设需要合并的工作簿在“D:/示例/数据记录/”文件夹中，含有两个工作簿test1.xls、test2.xls（当然，可以不限于两个），在test1.xls工作簿中含有三张工作表，在test2.xls工作簿中含有两张工作表，现在使用一段VBA代码合并这两个工作簿到一个新工作簿中，合并到新工作簿中的工作表分别以原工作簿名加索引值命名。代码如下：

Sub CombineWorkbooks()
    Dim strFileName As String
    Dim wb As Workbook
    Dim ws As Object

    '包含工作簿的文件夹,可根据实际修改
    Const strFileDir As String = "D:/示例/数据记录/"

    Application.ScreenUpdating = False

    Set wb = Workbooks.Add(xlWorksheet)
    strFileName = Dir(strFileDir & "*.xls*")

    Do While strFileName <> vbNullString
        Dim wbOrig As Workbook
        Set wbOrig = Workbooks.Open(Filename:=strFileDir & strFileName, ReadOnly:=True)
        strFileName = Left(Left(strFileName, Len(strFileName) - 4), 29)

        For Each ws In wbOrig.Sheets
            ws.Copy After:=wb.Sheets(wb.Sheets.Count)
            If wbOrig.Sheets.Count > 1 Then
                wb.Sheets(wb.Sheets.Count).Name = strFileName & ws.Index
            Else
                wb.Sheets(wb.Sheets.Count).Name = strFileName
            End If
        Next

        wbOrig.Close SaveChanges:=False

        strFileName = Dir

    Loop

    Application.DisplayAlerts = False
    wb.Sheets(1).Delete
    Application.DisplayAlerts = True

    Application.ScreenUpdating = True

    Set wb = Nothing

End Sub