通过VBA合并数据：解决粘贴公式引发#REF!错误问题

原代码使用Range.Copy直接粘贴会包含源单元格的公式，关闭源工作簿后公式引用失效，导致目标单元格出现#REF!错误。只需将粘贴方式改为PasteSpecial xlPasteValues，仅粘贴单元格数值即可解决。

修改后的完整代码 #

Sub ConsolidateData()

    Dim sourcePath As String
    Dim folderName As Variant
    Dim sourceFile As String
    Dim SourceBook As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastrow As Long
    Dim targetRow As Long
    Dim i As Long

    '设置源目录路径
    sourcePath = "C:\Windows\Blackstone\Software\Box\Internal Control\L1 & L2 Review Project\Checklist"

    '设置目标工作表
    Set targetSheet = ThisWorkbook.Worksheets("Overview")

    '若目标工作表表头为空则复制表头
    If Application.CountA(targetSheet.Range("A1:XFD1")) = 0 Then
        targetSheet.Range("A1:XFD1").Value = Array("Tab Name", "Activity", "SOP Status", "CQ Quarter Transition", "Quarter of Transition", "Source Systems", "Exclusions/Exceptions", "Comments", "Criticality", "Time spent L1 (mins)", "Est. Time Spent L2 (mins)", "L2 Applicable")
    End If

    '遍历源目录下的每个文件夹
    For Each folderName In Array("Asia Business Finance", "Asia Finance I PM", "BEPIF FPA", "BPP Finance", "BREDS AM", "BREDS Loan Ops", "BREIT FP&A and PM", "BREP Finance", "Common Activities", "EMEA PM", "Europe PM", "US PM")
        '设置源文件夹路径
        sourcePath = "C:\Windows\Blackstone\Software\Box\Internal Control\L1 & L2 Review Project\Checklist\Chicklist2\" & folderName & "\"

        '遍历源文件夹下的每个文件
        sourceFile = Dir(sourcePath & "*.xlsx")
        Do While sourceFile <> ""
            '打开源工作簿
            Set SourceBook = Workbooks.Open(sourcePath & sourceFile)

            '设置源工作表
            Set sourceSheet = SourceBook.Worksheets("Overview")

            '查找源工作表的最后一行
            lastrow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row

            '遍历源工作表的每一行
            For i = 2 To lastrow
    
                '检查该行是否符合复制条件
                If sourceSheet.Cells(i, "A").Value <> "" Then

                    '将该行复制到目标工作表（仅粘贴数值）
                    targetRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
                    sourceSheet.Range("A" & i & ":L" & i).Copy
                    targetSheet.Range("B" & targetRow & ":M" & targetRow).PasteSpecial xlPasteValues
                    targetSheet.Cells(targetRow, "A").Value = folderName '将文件夹名称添加至A列
                    Application.CutCopyMode = False '清除剪贴板内容
                End If
            Next i

            '关闭源工作簿
            SourceBook.Close SaveChanges:=False

            '获取目录中的下一个文件
            sourceFile = Dir
        Loop
    Next folderName

    '保存目标工作簿
    ThisWorkbook.Save

End Sub

关键修改说明 #

• 拆分原直接复制粘贴的代码，通过PasteSpecial xlPasteValues参数仅粘贴单元格数值，避免携带源文件公式
• 添加Application.CutCopyMode = False清除剪贴板，防止后续操作出现异常
• 关闭源工作簿时增加SaveChanges:=False参数，避免误修改源文件

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