无法消除运行时错误1004

Question

我正在尝试将不同工作表上的表格中的多个数据复制到另一个工作表上的新表格中。我的结构如下：

这些是我和@QHarr先生尝试过的步骤：

1. 检查对象和值是否存在
2. 尝试逐行运行代码
3. 激活工作表并重新排列代码

到目前为止没有工作：



这是我目前的代码：

Private Sub cmdedit_Click()
If MsgBox("Transfer selected asset to " & Me.ComboBox1.Text & "?", vbYesNo, "CONFIRMATION") = vbYes Then

Dim ws As Worksheet
Dim ws1 As Worksheet
Dim wsendRow As Range
Dim wsendRow1 As Range
Dim lo As ListObject
Dim lr As ListRow

Set ws = Sheets("FIELD OFFICE DATABASE")
Set ws1 = Sheets("Transferred Items")
Set lo = ws1.ListObjects("table3")
Set lr = lo.ListRows.Add

Set wsendRow = ws.Range("B" & Rows.Count).End(xlUp)
'Set wsendRow1 = ws1.Range("A" & Rows.Count).End(xlUp)

ws.Activate

Range("B2").Select

Do Until ActiveCell.Address = wsendRow.Address

If ActiveCell.Value = Me.cmbemn.Text Then
'ws1.Unprotect "321321"
'ws1.Activate
lr.Range(1, 1).Value = Me.cmbemn.Text 'error appears on this line. if I place a comment here, the error will just move on the next line.
lr.Range(1, 2).Value = Me.TextBox1.Text
lr.Range(1, 3).Value = Me.txttype.Text
lr.Range(1, 4).Value = Me.txtmodel.Text
lr.Range(1, 5).Value = ActiveCell.Offset(0, 4).Value
lr.Range(1, 6).Value = ActiveCell.Offset(0, 5).Value
lr.Range(1, 7).Value = Me.txtpurdate.Text
lr.Range(1, 8).Value = Me.txtprice.Text
lr.Range(1, 9).Value = Me.txtcon.Text
lr.Range(1, 10).Value = ActiveCell.Offset(0, 9).Value
lr.Range(1, 11).Value = ActiveCell.Offset(0, 11).Value
lr.Range(1, 12).Value = Me.ComboBox1.Text
lr.Range(1, 13).Value = ActiveCell.Offset(0, 13).Value
lr.Range(1, 14).Value = Date
lr.Range(1, 15).Value = ws.Range("A13").Value
lr.Range(1, 16).Value = Me.TextBox2.Text
Exit Do
Exit Sub
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End If
End Sub    

代码从未奏效。另外需要注意的是，这个问题是关于我的other question（我收到了很多来自我和QHarr先生的评论）的问题，直到他建议我应该提出另一个问题。

我希望有人可以帮我解决这个问题。

非常感谢你提前