Excel宏异常求助：复制R列至下一列功能无法正常执行

原代码问题根源 #

你当前的代码核心问题出在目标列的定位逻辑上：
pasteSheet.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1) 是通过第一行最右侧的非空单元格来推导目标列，但这个逻辑存在致命缺陷：

• 如果R列第一行本身为空，复制后目标列第一行也为空，End(xlToLeft) 会直接跳转到第一行最左侧的非空单元格，导致目标列完全偏离预期的S列。
• 工作表其他列的现有数据会干扰定位，导致每次运行都粘贴到同一个错误位置。

解决方案一：按顺序逐列粘贴（符合你的核心需求） #

这个方案会严格按照「S→T→U…」的顺序逐列粘贴，不受其他列数据影响，通过一个隐藏单元格记录上次粘贴的列号：

Sub CopyPaste()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim lastPasteCol As Long
    Dim targetCol As Long
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 读取上次粘贴的列号，首次运行默认R列（18）
    If ws.Range("Z1").Value = "" Then
        lastPasteCol = 18
    Else
        lastPasteCol = ws.Range("Z1").Value
    End If
    
    targetCol = lastPasteCol + 1 ' 计算本次目标列
    
    ' 直接复制R列到目标列
    ws.Range("R:R").Copy Destination:=ws.Columns(targetCol)
    
    ' 更新记录的列号
    ws.Range("Z1").Value = targetCol
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

使用说明 #

• 首次运行会自动粘贴到S列，之后每次运行都会往右递进一列。
• 可以右键点击Z列选择「隐藏」，避免误修改记录单元格。

解决方案二：粘贴到R列右侧第一个空列（可选） #

如果你的需求是跳过已有数据的列，每次粘贴到R列右侧第一个整列为空的位置，可以用这个版本：

Sub CopyPasteToFirstEmptyCol()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim targetCol As Long
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 从S列（19列）开始，查找第一个整列无数据的列
    targetCol = 19
    Do Until WorksheetFunction.CountA(ws.Columns(targetCol)) = 0
        targetCol = targetCol + 1
    Loop
    
    ' 复制R列到目标列
    ws.Range("R:R").Copy Destination:=ws.Columns(targetCol)
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

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