如何实现每次运行VBA代码将同一单元格内容粘贴到下一个单元格

我来帮你调整代码，实现每次运行时把Sheet2的B4内容粘贴到Sheet3第4行的下一个空列里——第一次到B4、第二次到C4，以此类推。

方案一：自动检测第4行的最后非空列（适合临时运行，关闭文件后重置） #

这个方案会每次运行时自动查找Sheet3第4行最右边的有内容单元格，然后下一列就是粘贴位置，逻辑简单直接：

Sub copyPasteValues()
    Dim sht2 As Worksheet
    Dim sht3 As Worksheet
    Dim nextCol As Long
    
    ' 定义工作表对象
    Set sht2 = Sheets("Sheet2")
    Set sht3 = Sheets("Sheet3")
    
    ' 从第4行最右侧单元格往左找最后一个非空单元格，获取其列号后加1
    nextCol = sht3.Cells(4, sht3.Columns.Count).End(xlToLeft).Column + 1
    
    ' 处理第4行完全为空的情况，默认从B列（列号2）开始
    If nextCol = 1 Then nextCol = 2
    
    ' 直接赋值（比Copy/PasteSpecial更高效，还不占用剪贴板）
    sht3.Cells(4, nextCol).Value = sht2.Cells(4, 2).Value
End Sub

代码说明：

• sht3.Cells(4, sht3.Columns.Count).End(xlToLeft)：这行代码模拟了手动按Ctrl+左箭头的操作，从第4行的最后一列（Excel最大列数）往左定位到最后一个有内容的单元格。
• 直接赋值Value替代Copy/PasteSpecial：不仅运行更快，还避免了剪贴板被修改的问题，是VBA中复制值的最佳实践。

方案二：记录上次粘贴位置（适合需要跨会话保存进度的场景） #

如果希望关闭Excel后再次打开，还能接着上次的位置继续粘贴，可以把上次的列号存在一个隐藏单元格里，比如Sheet3的A1（可以把A列隐藏起来）：

Sub copyPasteValues()
    Dim sht2 As Worksheet
    Dim sht3 As Worksheet
    Dim nextCol As Long
    
    Set sht2 = Sheets("Sheet2")
    Set sht3 = Sheets("Sheet3")
    
    ' 检查记录位置的单元格（这里用Sheet3的A1）是否为空
    If IsEmpty(sht3.Range("A1")) Then
        nextCol = 2 ' 第一次运行从B4开始
    Else
        nextCol = sht3.Range("A1").Value + 1 ' 上次列号加1
    End If
    
    ' 粘贴内容到目标单元格
    sht3.Cells(4, nextCol).Value = sht2.Cells(4, 2).Value
    
    ' 更新记录的列号，方便下次运行使用
    sht3.Range("A1").Value = nextCol
End Sub

使用提示：

• 可以右键点击A列，选择「隐藏」，避免用户误修改记录的列号。
• 如果不想用A1，也可以换成其他不常用的单元格（比如Z1、AA1等）。

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