VBA粘贴Excel数据至DATA表首空行失效及空值校验问题

问题1：粘贴覆盖首行数据的根因 #

• 核心逻辑缺失：计算最后非空行号lastrow时，没有明确指定所属工作表，代码运行到该行时活动表仍是源表Invoer Cursisten，取到的行号是源表A列的最后行位置，并非目标DATA表的行号，导致粘贴位置完全错误。
• 附加问题：硬编码65536行仅兼容2003及更早版本Excel，高版本Excel单表最大行数远大于该值，会出现行号计算错误；lastrow + 2会人为多空出一行，要粘贴到现有表格首个空行应使用lastrow + 1。

问题2：必填项空值校验实现方式 #

• 在执行复制操作前增加前置校验逻辑：先遍历待复制范围内的有效数据行，逐行检查预设的必填单元格内容
• 只要检测到必填项为空，立刻弹出提示框标注空值所在位置，直接终止后续复制、粘贴、清空源区域的全流程，避免无效数据写入目标表
• 校验通过后再执行数据写入操作

修正后可直接运行的代码 #

Sub CommandButton1_Click()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim copyRng As Range
    Dim lastrow As Long
    Dim i As Long, j As Long
    Dim requiredCols As Variant
    Dim hasEmpty As Boolean
    Dim emptyTip As String
    
    ' 绑定工作表与待复制范围，无需激活工作表即可操作，避免界面闪烁
    Set wsSource = ThisWorkbook.Worksheets("Invoer Cursisten")
    Set wsTarget = ThisWorkbook.Worksheets("DATA")
    Set copyRng = wsSource.Range("B11:K40")
    
    ' ========== 按需修改此处配置 ==========
    ' 数组内填写必填字段在待复制范围内的列序号：1对应范围首列（原表B列）、2对应范围第二列（原表C列），可自行增减
    requiredCols = Array(1, 2, 3)
    ' =====================================
    
    hasEmpty = False
    emptyTip = "以下必填项为空，请补充后再提交：" & vbCrLf
    
    ' 逐行校验必填项
    For i = 1 To copyRng.Rows.Count
        ' 跳过整行全空的无效行
        If Application.WorksheetFunction.CountA(copyRng.Rows(i)) > 0 Then
            For Each j In requiredCols
                If Trim(copyRng.Cells(i, j).Value) = "" Then
                    hasEmpty = True
                    ' 记录空值具体位置
                    emptyTip = emptyTip & "工作表「Invoer Cursisten」第" & copyRng.Cells(i, j).Row & "行 " & Split(copyRng.Cells(i, j).Address, "$")(1) & "列" & vbCrLf
                End If
            Next j
        End If
    Next i
    
    ' 存在空值则弹窗提示，终止流程
    If hasEmpty Then
        MsgBox emptyTip, vbExclamation, "数据校验不通过"
        Exit Sub
    End If
    
    ' 正确计算目标表A列最后非空行，兼容所有Excel版本
    lastrow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    
    ' 粘贴数值到首个空行
    copyRng.Copy
    wsTarget.Cells(lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
    
    ' 清空源表输入区域
    wsSource.Range("B12:K41").Clear
    
    ' 清除剪贴板状态，避免弹出剪贴板占用提示
    Application.CutCopyMode = False
End Sub

代码说明：如果必填列有调整，只需要修改requiredCols = Array(1, 2, 3)这一行的数组内容即可，比如只需要B列、E列为必填，就改成requiredCols = Array(1, 4)（因为E列是待复制范围B11:K40的第4列）。

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