VBA工作表数据迁移问题：需实现ID#随条目同步填充

我编写了一段VBA代码，用于将数据从一个工作表迁移至另一个工作表实现记录留存，但目前ID#无法随其余条目一同正确填充。现有代码如下：

Sub Button4_Click()
'Create and set variables for the Call Tracking & Call Log worksheets
Dim Form As Worksheet, DB As Worksheet

Set Form = Sheet1
Set DB = Sheet2


'Create and set variables for each cell in the call tracking sheet
Dim IDNum As Range, Item As Range, QTY As Range

Set IDNum = Form.Range("C9:D9")
Set Item = Form.Range("C11")
Set QTY = Form.Range("C13")


'Create a variable for the paste cell in the Call Log worksheet
Dim DestCell As Range

If DB.Range("A2") = "" Then 'If A2 is empty
    Set DestCell = DB.Range("A2") '...then destination cell is A2
Else
    Set DestCell = DB.Range("A1").End(xlDown).Offset(1, 0) '...otherwise the next empty row
End If

'If no "Number called has been entered, exit macro
If IDNum = "" Then
    MsgBox "You must enter an ID#"
    Exit Sub
End If

'Copy and paste data from the Call Tracking worksheet to the Call Log worksheet
IDNum.Copy DestCell
Item.Copy DestCell.Offset(0, 1)
Country.Copy DestCell.Offset(0, 2)
QTY.Copy DestCell.Offset(0, 3)

Call Macro1
'Clear the contents in the Call Tracking worksheet
End Sub

问题分析 #

1. IDNum区域处理错误：你把IDNum设为C9:D9（两个单元格），复制到DestCell时会占用目标表的A、B列，但后续Item又从DestCell.Offset(0,1)（B列）开始粘贴，直接覆盖了IDNum的第二部分，同时导致后续列全部错位。另外，直接用IDNum = ""判断多单元格区域是否为空逻辑无效，只要区域内有一个非空值，这个判断就不成立。
2. 未定义变量：代码中使用了Country变量，但既没声明也没赋值，运行时会触发错误。
3. 空行定位不可靠：Range("A1").End(xlDown)如果A列中间有空行，会直接定位到空行上方的最后一行，导致数据覆盖或遗漏。

修复后的代码 #

Sub Button4_Click()
    ' 定义工作表变量
    Dim Form As Worksheet, DB As Worksheet
    Set Form = Sheet1
    Set DB = Sheet2

    ' 定义数据单元格变量（按需调整IDNum区域）
    Dim IDNum As Range, Item As Range, Country As Range, QTY As Range
    Set IDNum = Form.Range("C9") ' 若ID#是单个单元格用这个；若需要C9:D9则改回Form.Range("C9:D9")
    Set Item = Form.Range("C11")
    Set Country = Form.Range("C12") ' 替换为实际Country数据所在单元格
    Set QTY = Form.Range("C13")

    ' 定位目标表下一个空行（更可靠的方式）
    Dim lastRow As Long
    lastRow = DB.Cells(DB.Rows.Count, "A").End(xlUp).Row
    Dim DestCell As Range
    Set DestCell = DB.Cells(IIf(lastRow = 1, 2, lastRow + 1), "A") ' 空表时从A2开始（假设A1是表头）

    ' 判断ID#是否为空
    If IDNum.Value = "" Then ' 单个单元格判断方式
        MsgBox "必须输入ID#"
        Exit Sub
    End If
    ' 若IDNum是C9:D9，用下面的判断：
    ' If WorksheetFunction.CountA(IDNum) = 0 Then
    '     MsgBox "必须输入ID#"
    '     Exit Sub
    ' End If

    ' 粘贴数据（根据IDNum区域调整偏移量）
    IDNum.Copy DestCell
    Item.Copy DestCell.Offset(0, 1)
    Country.Copy DestCell.Offset(0, 2)
    QTY.Copy DestCell.Offset(0, 3)
    ' 若IDNum是C9:D9，后续数据要从第3列开始：
    ' IDNum.Copy DestCell
    ' Item.Copy DestCell.Offset(0, 2)
    ' Country.Copy DestCell.Offset(0, 3)
    ' QTY.Copy DestCell.Offset(0, 4)

    Call Macro1
    ' 清空表单内容（按需启用）
    ' IDNum.ClearContents
    ' Item.ClearContents
    ' Country.ClearContents
    ' QTY.ClearContents
End Sub

关键修改说明 #

• IDNum区域适配：如果ID#是单个单元格，直接用Form.Range("C9")；如果需要C9和D9的内容，粘贴后后续数据要从Offset(0,2)开始，避免列错位。
• 空值判断修正：单个单元格直接判断Value；多单元格用CountA统计非空数量，为0则说明未输入。
• 补全Country变量：必须声明并赋值对应的数据源单元格。
• 可靠定位空行：从A列底部向上找最后一个非空行，避免中间空行导致的错误。
• 补充清空逻辑：原代码注释了清空操作，可根据需要添加ClearContents语句。

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