请求修改VBA代码：将指定行复制到另一工作表且保留原表数据

修改说明 #

• 新增触发变量K，仅当K=1时执行复制操作
• 修正原代码循环判断的逻辑错误，正确遍历Contact表C列每行的值
• 仅复制符合条件的行到Lead Created表，不删除Contact表中的数据
• 优化空表处理逻辑，避免目标表为空时的写入错误

修改后的代码 #

Sub CopyRowtoAnotherTab()
' 修改后实现：变量K=1时触发复制，保留原表数据
    Dim xRg As Range
    Dim A As Long, B As Long, C As Long
    Dim K As Long ' 触发变量

    ' 设置触发条件，可根据需要修改K的值
    K = 1

    If K <> 1 Then Exit Sub ' 仅当K=1时执行后续操作

    ' 获取Contact表已用行数
    A = Worksheets("Contact").UsedRange.Rows.Count
    ' 获取Lead Created表已用行数，处理空表情况
    B = Worksheets("Lead Created").UsedRange.Rows.Count
    If B = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Lead Created").UsedRange) = 0 Then B = 0
    End If

    ' 定义要判断的列范围（Contact表的C列）
    Set xRg = Worksheets("Contact").Range("C1:C" & A)

    Application.ScreenUpdating = False ' 关闭屏幕刷新提升效率
    For C = 1 To xRg.Count
        ' 判断当前行C列的值是否为"1"，符合则复制整行
        If CStr(xRg(C).Value) = "1" Then
            xRg(C).EntireRow.Copy Destination:=Worksheets("Lead Created").Range("A" & B + 1)
            B = B + 1 ' 更新目标表的行数指针
        End If
    Next C
    Application.ScreenUpdating = True ' 恢复屏幕刷新
End Sub

使用提示 #

• 若需通过单元格值控制触发（比如用Sheet1的D1单元格值作为K），可将K = 1替换为K = Worksheets("Sheet1").Range("D1").Value，修改该单元格为1即可触发复制
• 若需调整判断列（当前为Contact表C列），修改Range("C1:C" & A)中的字母C为目标列标识即可

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