Excel VBA合并单元格取值问题：跨工作簿批量提取数据失败

首先，先拆解你遇到的两个问题根源：

• MODULE1问题：大概率是代码混淆了ThisWorkbook（运行宏的目标文件）和源工作簿对象，错误地从目标文件而非打开的供应商文件中提取数据。
• MODULE2问题：合并单元格的取值/粘贴逻辑有漏洞，可能是复制了单元格格式/链接而非纯值，或者未明确锁定源工作簿的单元格引用，导致粘贴内容未自动刷新（手动回车相当于强制触发值更新）。

下面是修正后的完整VBA代码，包含批量处理、精准取值、写入目标文件的完整逻辑：

Sub ExtractSupplierData()
    Dim wbSource As Workbook
    Dim wbTarget As Workbook
    Dim wsTarget As Worksheet
    Dim sourceFolderPath As String
    Dim targetFilePath As String
    Dim supplierFileName As String
    Dim nextEmptyRow As Long
    
    ' 1. 配置路径（替换成你实际的文件路径）
    targetFilePath = "C:\YourFolder\Target_Workbook.xlsx" ' 目标文件路径
    sourceFolderPath = "C:\YourFolder\Supplier_Files\" ' 供应商文件所在文件夹
    
    ' 2. 引用或打开目标文件
    On Error Resume Next
    Set wbTarget = Workbooks(Dir(targetFilePath))
    On Error GoTo 0
    If wbTarget Is Nothing Then
        Set wbTarget = Workbooks.Open(targetFilePath)
    End If
    Set wsTarget = wbTarget.Worksheets("DataSheet") ' 替换成目标工作表名称
    
    ' 3. 遍历所有供应商Excel文件
    supplierFileName = Dir(sourceFolderPath & "*.xlsx") ' 仅处理xlsx格式，如需xls可改为*.xls
    Application.ScreenUpdating = False ' 关闭屏幕刷新，提升速度
    
    Do While supplierFileName <> ""
        ' 打开源文件（只读模式避免锁定）
        Set wbSource = Workbooks.Open(sourceFolderPath & supplierFileName, ReadOnly:=True)
        
        ' 4. 提取合并单元格的值（合并单元格直接取Value即可）
        Dim valGH327 As Variant
        Dim valGH356 As Variant
        Dim valGH358 As Variant
        Dim valGH360 As Variant
        
        ' 如果源数据固定在某张工作表，把ActiveSheet改成具体表名，比如wbSource.Worksheets("MainSheet")
        valGH327 = wbSource.ActiveSheet.Range("GH327").Value
        valGH356 = wbSource.ActiveSheet.Range("GH356").Value
        valGH358 = wbSource.ActiveSheet.Range("GH358").Value
        valGH360 = wbSource.ActiveSheet.Range("GH360").Value
        
        ' 5. 写入目标文件的F/G/H/I列
        nextEmptyRow = wsTarget.Cells(wsTarget.Rows.Count, "F").End(xlUp).Row + 1
        wsTarget.Cells(nextEmptyRow, "F").Value = valGH327 ' F列（kg）
        wsTarget.Cells(nextEmptyRow, "G").Value = valGH356 ' G列（cm）
        wsTarget.Cells(nextEmptyRow, "H").Value = valGH358 ' H列（cm）
        wsTarget.Cells(nextEmptyRow, "I").Value = valGH360 ' I列（cm）
        
        ' 6. 关闭源文件，不保存
        wbSource.Close SaveChanges:=False
        Set wbSource = Nothing
        
        ' 取下一个供应商文件
        supplierFileName = Dir()
    Loop
    
    ' 收尾操作
    Application.ScreenUpdating = True
    wbTarget.Save
    MsgBox "所有供应商数据提取完成！", vbInformation
End Sub

关键修正细节： #

1. 明确工作簿对象：
   用wbSource和wbTarget分别锁定源文件和目标文件，彻底避免ActiveWorkbook或ThisWorkbook的混淆——这正是MODULE1出错的核心原因。
2. 合并单元格取值优化：
   合并单元格的Value属性会直接返回显示值，无需额外处理；如果遇到取值异常，可改用wbSource.ActiveSheet.Range("GH327").TopLeftCell.Value，确保取到合并区域左上角的原始值。
3. 直接赋值替代复制粘贴：
   放弃Copy/Paste流程，直接将提取的值赋值给目标单元格，彻底解决MODULE2中需要手动回车刷新的问题（复制粘贴可能携带格式/链接，直接赋值只传递纯值）。
4. 批量处理优化：
   加入ScreenUpdating = False提升运行速度，同时以只读模式打开源文件，防止文件锁定或意外修改。

针对现有宏的单独修正建议： #

• 修改MODULE1：检查代码中是否误将ThisWorkbook（目标文件）作为数据源，将所有提取数据的Range引用改为wbSource.具体工作表名.Range(...)。
• 修改MODULE2：将Copy+Paste改为PasteSpecial xlPasteValues，例如：

  wbSource.ActiveSheet.Range("GH327").Copy
  wsTarget.Cells(nextRow, "F").PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  

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