如何实现非相邻单元格复制转置粘贴（非整行）并解决TargetRow重置问题

我明白你的需求：要把Form工作表里的非相邻区域TicketData和Scores转置后粘贴到DB工作表的指定列，而且不能覆盖已有数据，要每次追加到下一行。你提到的TargetRow初始值为0是变量声明后的默认值，执行计算语句后得到正确行号是正常的，但如果重新运行时出现覆盖或没有正确追加的情况，问题大概率出在判断最后一行的依据列不对。

问题分析 #

你的代码里用A列（Cells(Rows.Count, 1)）来定位目标表的最后一行，但如果DB工作表的A列没有数据，End(xlUp)会默认回到第1行，导致每次计算出来的TargetRow都是2，重复覆盖同一行，看起来就像TargetRow又“回到0”重新开始了。

修正后的代码 #

我们应该用你实际粘贴数据的列（比如F列，因为第一个数据粘贴到F列）来判断最后一行，这样就能确保每次都定位到下一个空白行：

Sub TransferData()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim TargetRow As Long
    
    ' 定义源和目标工作表
    Set wsSource = ThisWorkbook.Worksheets("Form")
    Set wsTarget = ThisWorkbook.Worksheets("DB")
    
    ' 基于F列（第一个粘贴数据的列）获取最后一行，避免A列无数据导致的错误
    TargetRow = wsTarget.Cells(wsTarget.Rows.Count, "F").End(xlUp).Row
    ' 如果F列是空的（首次运行），默认从第2行开始（假设第1行是表头）
    If TargetRow = 1 And wsTarget.Range("F1").Value = "" Then
        TargetRow = 2
    Else
        TargetRow = TargetRow + 1
    End If
    
    ' 复制TicketData并转置粘贴到F列开始的行
    wsSource.Range("TicketData").Copy
    wsTarget.Range("F" & TargetRow).PasteSpecial Paste:=xlValues, Transpose:=True
    
    ' 复制Scores并转置粘贴到Q列开始的行
    wsSource.Range("Scores").Copy
    wsTarget.Range("Q" & TargetRow).PasteSpecial Paste:=xlValues, Transpose:=True
    
    ' 清除剪贴板，避免后续操作受影响
    Application.CutCopyMode = False
End Sub

关键改进点 #

• 定位最后一行的列修正：改用F列来判断，因为这是你第一个粘贴数据的列，能准确获取已有数据的最后位置
• 首次运行处理：如果F列完全为空，默认从第2行开始（适配表头在第1行的常见场景）
• 添加剪贴板清除：避免复制粘贴后剪贴板保留内容，影响其他操作

额外注意事项 #

• 确保TicketData和Scores这两个命名区域的范围是正确的，包含你需要复制的非相邻单元格
• 如果你的目标表表头不在第1行，可以调整代码里的TargetRow = 2为对应的起始行号

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