求VBA代码实现无需提前保存即可合并多个未保存的Excel工作簿

原代码问题说明 #

原代码逻辑为遍历本地指定文件夹内的Excel文件、打开后合并工作表，未对当前Excel进程中已打开的未保存临时工作簿（自动命名为Book1/Book2等）做处理，因此无法满足需求。

修正后代码 #

Sub MergeOpenedTempBooks()
    Dim xWS As Worksheet
    Dim xMWS As Worksheet
    Dim xTWB As Workbook
    Dim xWB As Workbook
    Dim xStrName As String
    Dim xArr As Variant
    Dim xI As Integer
    
    On Error Resume Next
    ' 可自定义需要合并的临时工作簿名称，逗号分隔
    xStrName = "Book1,Book2,Book3,Book4"
    xArr = Split(xStrName, ",")
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ' 汇总工作簿为当前运行代码的工作簿
    Set xTWB = ThisWorkbook
    
    ' 遍历当前Excel进程所有已打开的工作簿
    For Each xWB In Application.Workbooks
        ' 跳过汇总工作簿本身，只匹配目标临时工作簿
        If xWB.Name <> xTWB.Name Then
            For xI = 0 To UBound(xArr)
                If xWB.Name = xArr(xI) Then
                    ' 复制该工作簿下所有工作表到汇总簿
                    For Each xWS In xWB.Sheets
                        xWS.Copy After:=xTWB.Sheets(xTWB.Sheets.Count)
                        Set xMWS = xTWB.Sheets(xTWB.Sheets.Count)
                        xMWS.Name = xWB.Name & "(" & xWS.Name & ")"
                    Next xWS
                    Exit For
                End If
            Next xI
        End If
    Next xWB
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

使用说明 #

• 如果需要合并所有名称前缀为Book的未保存工作簿，无需手动列全名称，可将匹配逻辑替换为If UCase(xWB.Name) Like "BOOK*" Then即可自动识别
• 代码不会关闭原有未保存的临时工作簿，不会造成数据丢失
• 工作表自动按「临时工作簿名称(原工作表名称)」规则命名，避免重名冲突

内容的提问来源于stack exchange，提问作者MJobbson