单列转多列VBA代码报错：PasteSpecial行触发运行时错误1004

先拆解下你代码里触发1004错误的核心问题：

• 无效反向范围：rng3.End(xlUp)如果从空的B3向上查找，会直接跳到Excel最左上角的XFD1，这时候Range(rng2, rng3.End(xlUp))变成了从A16到XFD1的反向范围，Excel根本无法处理这种无效范围。
• 固定范围变量：rng1、rng2这些变量只在初始化时赋值，循环过程中完全没更新，导致每次处理都是同一个固定范围，逻辑彻底混乱。
• 插入列后目标位置错误：插入F列后直接粘贴到F3，但没考虑已处理内容的位置，剪切粘贴的时机和范围完全不匹配。

针对你「按"SUNDAY"分隔单列内容到多列」的需求，我重新写了逻辑清晰的修正代码，彻底解决这些问题：

Sub SplitSingleColumnToMulti()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim startRow As Long
    Dim endRow As Long
    Dim targetCol As Long
    
    ' 初始化工作表和核心参数
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 动态获取A列最后一行
    startRow = 3 ' 数据起始行（A3）
    targetCol = 2 ' 目标起始列（B列）
    
    ' 遍历A列，按"SUNDAY"分段处理
    For endRow = startRow To lastRow
        ' 触发条件：找到"SUNDAY"或到达最后一行
        If InStr(ws.Cells(endRow, "A").Value, "Sunday") > 0 Or endRow = lastRow Then
            ' 调整结束行：如果是最后一行就用lastRow，如果是Sunday就取它的上一行
            Dim currentEndRow As Long
            currentEndRow = IIf(endRow = lastRow, endRow, endRow - 1)
            
            ' 复制当前段到目标列，避免剪切粘贴的范围失效问题
            ws.Range(ws.Cells(startRow, "A"), ws.Cells(currentEndRow, "A")).Copy _
                Destination:=ws.Cells(3, targetCol)
            
            ' 更新参数：目标列右移一列，起始行跳到当前段的下一行
            targetCol = targetCol + 1
            startRow = endRow + 1
        End If
    Next endRow
End Sub

代码关键优化点： #

1. 动态行号获取：用ws.Cells(ws.Rows.Count, "A").End(xlUp).Row精准获取A列有数据的最后一行，避免固定5000行的冗余。
2. 分段标记逻辑：用startRow和endRow标记每一段的起止位置，遇到分隔符就完成当前段的复制，自动推进到下一段。
3. 安全复制方式：直接用Copy Destination方法，跳过容易出问题的剪切+粘贴操作，确保范围始终有效。
4. 自动扩展列：每处理完一段就把目标列向右移动，无需手动插入列，逻辑更顺畅。

补充下你之前尝试方法失败的原因：

• 剪切粘贴失败：源范围是无效的反向范围，Excel无法执行操作。
• Value2赋值失败：同样是源范围无效，导致赋值操作无法完成。
• 仅复制单个条目：循环中没有更新rng1/rng2，每次都在处理同一个固定范围。

如果你的需求必须从底部向上处理（避免插入列影响行号），可以告诉我细节，我再调整反向遍历的版本。

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