VBA宏问题：选中行内容拼接后覆盖其他列数据，求修复方案

你的代码在选中不连续列时会触发覆盖问题：当选中非连续列（比如A列和C列），SelectedRange.Offset(, SelectedRange.Columns.Count) 指向的是选中区域左上角偏移对应列数的位置（比如A列偏移2列是C列），而非你插入的新列（C列右侧的D列），导致拼接结果直接覆盖原有列的数据。即使选中连续列，依赖原SelectedRange的偏移计算也可能因插入列后工作表结构变化出现逻辑偏差。

核心思路是：先明确记录插入新列的绝对位置，而非依赖原选中区域的偏移计算。修改后的代码如下：

Sub ConcatenateSelectedColumns()
    Dim SelectedRange As Range
    Dim LastCol As Long
    Dim NewCol As Long
    Dim Cell As Range
    Dim ConcatenatedValue As String
    Dim Area As Range
    Dim RowNum As Long

    Set SelectedRange = Selection
    ' 处理未选中任何区域的情况
    If SelectedRange Is Nothing Then Exit Sub

    ' 获取选中区域最右侧的列号（兼容连续/不连续列）
    LastCol = 0
    For Each Area In SelectedRange.Areas
        If Area.Column + Area.Columns.Count - 1 > LastCol Then
            LastCol = Area.Column + Area.Columns.Count - 1
        End If
    Next Area

    ' 在最后选中列右侧插入新列
    Columns(LastCol + 1).Insert
    NewCol = LastCol + 1

    ' 设置新列表头
    Cells(1, NewCol).Value = "New Column"

    ' 遍历选中区域的每一行
    For RowNum = SelectedRange.Row To SelectedRange.Row + SelectedRange.Rows.Count - 1
        ConcatenatedValue = ""
        ' 遍历当前行内所有选中的单元格
        For Each Cell In Intersect(SelectedRange, Rows(RowNum))
            ConcatenatedValue = ConcatenatedValue & Cell.Value
        Next Cell
        ' 将拼接结果写入新列对应行
        Cells(RowNum, NewCol).Value = ConcatenatedValue
    Next RowNum
End Sub

• 准确锁定新列位置：通过遍历选中区域的所有块（Areas）找到最右侧列，确保新列插入位置绝对正确，不会因选中区域不连续出错。
• 直接操作新列：用列号（NewCol）定位新列，彻底避免依赖原选中区域的偏移计算，从根源解决覆盖问题。
• 优化遍历逻辑：通过行号循环配合Intersect，精准获取当前行的选中单元格，兼容各种选中场景。
• 增加容错判断：避免因未选中区域导致的运行报错。

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