只有部分行复制到另一个表

Question

所以我有一个工作簿可以根据它的ITEMNO将行复制到另一个工作表的另一个表中。

但我的问题是我似乎无法复制整行。 E.g

Sheet 1中

它应该工作的方式是，一旦你从选择列表中选择一个值，它应该将该行添加到下面的下一页上的表的末尾

Sheet2的

仅添加了ITEMNO。

有人能告诉我以下需要修复的VBA中缺少什么吗？

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, i As Long, lRow As Long

If Not Intersect(Target, [SerialNumber]) Is Nothing Then
    i = Application.Match(Target, [Table1[ITEMNO]], 0)
    x = ActiveSheet.ListObjects(1).ListRows(i).Range
    With Sheet2
        If .[a2] = "" Then lRow = 2 Else lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(lRow, 1) = Array(x(1, 1), x(1, 2), x(1, 5), x(1, 6), x(1, 8))
    End With
End If

End Sub

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim x, lRow As Long

If Not Intersect(Target, [Table1[ITEMNO]]) Is Nothing Then
    x = ActiveSheet.ListObjects(1).ListRows(Target.Row - 2).Range
    With Sheet2
        If .[a2] = "" Then lRow = 2 Else lRow = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(lRow, 1) = _
        Array(Target, Target.Offset(, 1), Target.Offset(, 2), Target.Offset(, 3), Target.Offset(, 4), Target.Offset(, 5), Target.Offset(, 6), Target.Offset(, 7))
    End With
End If

End Sub

SerialNumber是在下拉列表中选择的内容。任何帮助将不胜感激

Answer 1

.Cells(lRow, 1) = Array(...)

您正在尝试分配数组但仅指定第一个单元格。 （Cells表示单个单元格。）

您需要扩展列的范围：

.Range(.Cells(lRow, 1), .Cells(lRow, 11)) = Array(...)

不是使用幻数 11，而是最好存储和重用包含值Range("K1").Column的变量。

更好的是命名表并使用Columns.Count始终识别最后一列。