【VBA案例020】整合工作簿

程技 VBA

发布时间 : 2023-10-23 00:00

字数:367 阅读 :

大家好！今天回答一位粉丝朋友的提问。

问题是：将多个工作簿中的所有工作表合并汇总，要求名称相同的工作表内容要合并在一起，名称不同的要单独作为一个工作表。

为此，我模拟了一份数据，结构如下图：

这个问题，其实是我之前分享的【案例011合并工作表】和【案例013汇总工作簿】的融合版。方法非常的相似。其实对于工作簿和工作表的合并与拆分的操作，之前的案例基本都分享完了。只要融会贯通，举一反三，相信这种问题将迎刃而解。

效果就不演示了，以下是VBA代码。详细解析请看文末的视频。

Option Explicit

Sub 汇总合并工作簿()
    Dim shtName
    Dim sht As Worksheet

    For Each sht In ThisWorkbook.Worksheets
        shtName = shtName & "," & sht.Name
    Next

    Dim filePath$, fileName As String

    filePath = ThisWorkbook.Path & "\文件夹\"
    fileName = Dir(filePath & "*.xlsx")

    Dim row_count, thisRow_count
    Application.ScreenUpdating = False
    Do While fileName <> ""
        With Workbooks.Open(filePath & fileName)
            For Each sht In .Worksheets
                If InStr("," & shtName & ",", "," & sht.Name & ",") > 0 Then
                    row_count = sht.[a65536].End(3).Row
                    thisRow_count = ThisWorkbook.Worksheets(sht.Name).[a65536].End(3).Row
                    sht.Range("a2:e" & row_count).Copy ThisWorkbook.Worksheets(sht.Name).Range("a" & thisRow_count + 1)
                Else
                    sht.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
                    shtName = shtName & "," & sht.Name
                End If
            Next
            .Close False
        End With
        fileName = Dir
    Loop
    Application.ScreenUpdating = True

End Sub

原始链接

转载请注明来源，欢迎对文章中的引用来源进行考证，欢迎指出任何有错误或不够清晰的表达。可以在下面评论区评论，也可以邮件至 richffan@outlook.com