Excel VBA数据保存覆盖首行问题：需实现数据连续追加

你当前的宏每次在表格首行插入新行并写入数据，导致覆盖原有首行内容。要实现数据连续保存到表格最后一个已保存单元格的需求，需调整行添加的位置和数据写入逻辑，修改后的代码如下：

Sub Transfer()
    Dim objList As ListObject
    Dim shForm As Worksheet
    Dim newRow1 As ListRow, newRow2 As ListRow ' 声明两个新行对象
    
    Set objList = ThisWorkbook.Sheets("KIT_ASSY").ListObjects("EmpTable")
    Set shForm = ThisWorkbook.Sheets("EGS DB")
    
    ' 在表格末尾添加两行新行（默认追加到列表最后）
    Set newRow1 = objList.ListRows.Add
    Set newRow2 = objList.ListRows.Add
    
    ' 给第一行新行赋值
    With newRow1
        .Range(1).Value = shForm.Range("h3").Value ' 参考编号
        .Range(2).Value = shForm.Range("b3").Value ' 参考编号
        .Range(3).Value = shForm.Range("c8").Value ' 参考编号
        .Range(4).Value = shForm.Range("d8").Value ' 参考编号
        .Range(5).Value = shForm.Range("g8").Value ' 参考编号
    End With
    
    ' 给第二行新行赋值
    With newRow2
        .Range(1).Value = shForm.Range("h3").Value ' 参考编号
        .Range(2).Value = shForm.Range("b3").Value ' 参考编号
        .Range(3).Value = shForm.Range("c9").Value ' 参考编号
        .Range(4).Value = shForm.Range("d9").Value ' 参考编号
        .Range(5).Value = shForm.Range("g9").Value ' 参考编号
    End With
    
    ThisWorkbook.Save
End Sub

Sub TransferToTable()
    Dim iMessage As VbMsgBoxResult
    iMessage = MsgBox("是否要传输数据？", vbYesNo + vbQuestion, "确认")
    If iMessage = vbNo Then Exit Sub
    Call Transfer
End Sub

修改说明 #

• 移除原代码中在首行插入新行的逻辑，改用ListRows.Add默认行为（不指定Position参数时，新行自动追加到表格末尾）
• 通过ListRow对象直接操作新添加的行，避免因行位置变化导致的覆盖问题
• 将确认弹窗的英文提示改为中文，适配中文使用场景

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