VBA实现合并单元格值批量复制至新工作表需求

针对你的需求，以下是优化后的VBA代码，直接解决合并单元格取值和可变工作表遍历的问题，同时避免原代码中Select/Activate的低效操作：

Sub CopyToMaster()
    Dim ws As Worksheet
    Dim masterWs As Worksheet
    Dim nextRow As Long
    
    ' 检查并创建目标工作表"Master"
    On Error Resume Next
    Set masterWs = ThisWorkbook.Worksheets("Master")
    On Error GoTo 0
    If masterWs Is Nothing Then
        Set masterWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        masterWs.Name = "Master"
        ' 写入表头（可选）
        masterWs.Range("A1:C1").Value = Array("E6值", "E(FG)5值", "E21值")
    End If
    
    ' 遍历所有工作表，跳过Master表
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> masterWs.Name Then
            ' 获取Master表的下一个空行
            nextRow = masterWs.Cells(masterWs.Rows.Count, "A").End(xlUp).Row + 1
            
            ' 直接读取单元格值，无需复制粘贴，合并单元格直接取左上角值即可
            masterWs.Cells(nextRow, "A").Value = ws.Range("E6").Value ' E6是EFG合并单元格，取其值
            masterWs.Cells(nextRow, "B").Value = ws.Range("F5").Value ' 对应E(FG)5，若实际是其他列可修改
            masterWs.Cells(nextRow, "C").Value = ws.Range("E21").Value
        End If
    Next ws
    
    MsgBox "数据汇总完成！", vbInformation
End Sub

关键说明： #

• 合并单元格处理：合并单元格的内容会保存在其左上角单元格中，所以直接通过ws.Range("E6").Value即可获取合并区域的值，无需复杂的复制粘贴操作。
• 可变工作表适配：通过For Each ws In ThisWorkbook.Worksheets遍历所有工作表，自动适配任意数量和名称的工作表，只需排除目标汇总表"Master"即可。
• 高效定位空行：使用Cells(Rows.Count, "A").End(xlUp).Row + 1快速找到A列最后一个非空行的下一行，比原代码的循环查找效率高得多。
• 避免Select/Activate：直接通过工作表对象引用单元格，减少代码运行时的错误概率，同时提升执行速度。

如果E(FG)5实际指的是E5或G5，只需把代码中ws.Range("F5").Value修改为对应单元格即可，比如ws.Range("E5").Value或ws.Range("G5").Value。

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