Excel VBA剪切F列满值行到montre vendu工作表代码问题咨询

原有代码存在的问题 #

• 无自动触发逻辑：你编写的是手动运行的普通宏，无法实现「F列填充完成后自动执行」的需求，需要绑定工作表Change事件实现自动触发
• 工作表名称不匹配：目标工作表名为montre vendu，代码中写为Montrevendu缺少空格，运行会直接报下标越界错误
• 粘贴位置语法错误：获取到目标表最后一行行号后，直接调用Range(derniereligne)是无效语法，需要定位到最后一行下一行的A列作为粘贴起始位置
• 依赖选中操作：大量使用Select、Selection对象，操作逻辑受用户当前选中区域干扰，稳定性极差
• 无触发条件判断：即使绑定事件后没有判断修改的单元格是否为F列，任意单元格修改都会触发剪切操作，不符合需求

修正后的完整实现代码 #

首先你需要把以下事件代码粘贴到数据源工作表的代码模块中（按Alt+F11打开VBA编辑器，左侧工程窗口双击对应的数据源工作表即可打开对应代码窗，不要粘贴到普通模块）：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 只判断修改的单元格是F列且仅修改了一个单元格的情况
    If Target.Column <> 6 Or Target.Cells.Count > 1 Then Exit Sub
    ' F列填充内容为空不执行
    If Target.Value = "" Then Exit Sub
    
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    Dim sourceRow As Range
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False ' 关闭事件触发，防止操作过程中重复触发事件造成死循环
    
    On Error GoTo ErrHandler ' 出错时恢复设置避免Excel卡死
    
    ' 定义目标工作表，注意名称带空格
    Set wsTarget = ThisWorkbook.Worksheets("montre vendu")
    ' 获取目标表最后一行行号
    lastRow = wsTarget.Range("A" & wsTarget.Rows.Count).End(xlUp).Row
    ' 定位当前修改行的整行
    Set sourceRow = Me.Rows(Target.Row)
    
    ' 剪切整行粘贴到目标表最后一行下方
    sourceRow.Cut Destination:=wsTarget.Rows(lastRow + 1)
    ' 剪切后删除源表空行（如果需要保留空行可以删除这行）
    sourceRow.Delete Shift:=xlUp
    
ErrHandler:
    ' 恢复系统设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "操作出错：" & Err.Description, vbCritical
End Sub

如果你需要保留手动运行的宏，可以用以下修正后的普通宏代码，放到普通模块中即可：

Sub coupercoller()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    Dim selectRange As Range
    
    Application.ScreenUpdating = False
    
    Set wsSource = ThisWorkbook.Worksheets("source")
    Set wsTarget = ThisWorkbook.Worksheets("montre vendu")
    Set selectRange = Selection
    
    ' 只处理选中的整行
    If selectRange.EntireRow.Address <> selectRange.Address Then
        MsgBox "请先选中要剪切的整行", vbExclamation
        GoTo EndSub
    End If
    
    lastRow = wsTarget.Range("A" & wsTarget.Rows.Count).End(xlUp).Row
    ' 直接剪切粘贴，无需选中操作
    selectRange.Cut Destination:=wsTarget.Rows(lastRow + 1)
    selectRange.Delete Shift:=xlUp
    
EndSub:
    Application.ScreenUpdating = True
End Sub

注意事项 #

• 工作簿需要保存为.xlsm或者.xlsb格式，否则宏代码会失效
• 如果目标表montre vendu是空表，首次运行会自动粘贴到第一行，无需额外处理
• 代码默认在剪切后删除源表的空行，如果需要保留空行可以删除sourceRow.Delete Shift:=xlUp这行代码

内容的提问来源于stack exchange，提问作者Cédric Coutant