VBA循环复制Excel数据后无法重新合并单元格问题排查

你的代码存在逻辑错误，并非Excel本身问题，以下是具体排查点和修复方案：

核心问题排查 #

• 循环范围不规范：For i = 1 To rg 中rg是Range对象，直接用对象作为循环终止值会依赖VBA默认属性（Value），若rg.Value非整数会引发异常，应明确写为For i = 1 To rg.Value。
• 复制区域重复覆盖：每次循环都将rg2复制到ws2.Range("B3").Resize(rowSize:=rg.Value - 1)，会反复覆盖B3开始的多行，完全不符合循环复制的预期。
• 合并区域定位错误：代码中ws2.Range("D" & i & ":F" & i)指向第i行（从1开始），但复制内容从第3行开始，相当于合并了无关行，自然看不到效果。
• 变量大小写不一致：Next I应为Next i，虽VBA不区分大小写，但规范写法可避免潜在问题。

修正后的代码 #

Sub NAD_Sheet()
    Dim i As Long
    Dim rg As Range, rg2 As Range
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim copyRows As Long ' 存储需要复制的行数

    Set ws1 = ThisWorkbook.Sheets("All-Points Frontsheet")
    Set ws2 = ThisWorkbook.Sheets("Adr")
    Set rg = ws1.Range("E34")
    Set rg2 = ws2.Range("B3:Q3")
    
    ' 清除目标区域内容并取消所有合并（避免残留影响）
    With ws2.Range("A4:Q500")
        .ClearContents
        .UnMerge
    End With
    
    copyRows = rg.Value
    ' 循环复制每行并合并指定区域
    For i = 1 To copyRows
        ' 将rg2复制到第3行开始的对应行
        rg2.Copy Destination:=ws2.Range("B" & 2 + i)
        ' 合并当前复制行的D到F列
        ws2.Range("D" & 2 + i & ":F" & 2 + i).MergeCells = True
    Next i
End Sub

额外排查点 #

• 工作表保护状态：如果Adr工作表被保护，合并单元格操作会被禁止，需先执行ws2.Unprotect Password:="你的密码"取消保护，操作完成后再重新保护。
• Excel信任中心设置：若禁用了VBA宏的部分功能，可能导致合并操作失效，确认宏设置为「启用所有宏（仅信任的文档）」。
• 工作表损坏测试：手动尝试在目标区域合并单元格，若也无法合并，可将内容复制到新工作表测试，排查原工作表是否损坏。

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