VBA复制数据到Database工作表空行粘贴失败问题求助

• 需求为搭建已打印文档台账数据库：设置单独工作表作为数据录入页，文件打印完成后通过VBA清空录入页所有内容，需将录入的核心数据同步复制到名为Database的工作表，留存所有历史打印文档记录。
• 待复制的源数据单元格对应关系：
  • 文档编号：D8单元格（必填，始终有值）
  • 日期1：I2单元格（必填，始终有值）
  • 日期2：E5单元格（必填，始终有值）
  • 变量1：P9单元格（非必填，仅部分场景有值）
  • 变量2：P12单元格（非必填，仅部分场景有值）
• 存储要求：写入数据的字段顺序匹配已有台账表结构，非必填字段无值时直接留空。
• 当前故障：已编写查找Database工作表首个空行的VBA代码，仅测试文档编号字段粘贴时始终无法成功写入，需要修正代码。

1. 工作表引用不明确：代码中Rows.Count、Range("D8")未绑定指定工作表，默认读取当前活动工作表对象，执行代码时如果活动工作表不是录入页，会出现定位错位。
2. 空行定位逻辑冗余：Cells(Rows.Count, 1).End(xlUp).Offset(1)本身已经可以定位到A列最后一个有值单元格的下一行，后续添加的整行非空判断循环属于多余逻辑，若台账中间存在整行空值会跳过正确写入位置。
3. 单元格赋值写法错误：nextEmptyCell本身已经是Range类型对象，外层再套Worksheets("Database").Range()属于非法写法，是导致赋值失败的直接原因。

Sub 同步打印记录到台账()
    Dim wsInput As Worksheet
    Dim wsDB As Worksheet
    Dim nextRow As Long
    
    ' 绑定工作表，将下方"录入页"替换为你实际使用的数据录入表名称
    Set wsInput = ThisWorkbook.Worksheets("录入页")
    Set wsDB = ThisWorkbook.Worksheets("Database")
    
    ' 定位台账表首个可写入空行
    nextRow = wsDB.Cells(wsDB.Rows.Count, "A").End(xlUp).Row + 1
    
    ' 按字段顺序写入数据，空值自动留空
    wsDB.Cells(nextRow, "A") = wsInput.Range("D8")  ' 文档编号，若台账中该字段不在A列，修改列标即可
    wsDB.Cells(nextRow, "B") = wsInput.Range("I2")  ' 日期1
    wsDB.Cells(nextRow, "C") = wsInput.Range("E5")  ' 日期2
    wsDB.Cells(nextRow, "D") = wsInput.Range("P9")  ' 变量1
    wsDB.Cells(nextRow, "E") = wsInput.Range("P12") ' 变量2

    ' 下方可直接衔接原有的打印、清空录入页的业务逻辑
End Sub

• 如果你的台账表各字段对应的列顺序和代码中A-E的顺序不一致，直接修改Cells(nextRow, "列标")中的列标为实际对应列即可。
• 代码提前绑定了固定工作表对象，执行时不需要手动切换工作表，不会出现活动页错位导致的写入错误。
• 非必填字段对应源单元格为空时，会自动在台账中写入空值，不需要额外增加判断逻辑。

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