excel - 匹配值并复制到同一行 Excel VBA

Question

我希望你们一切都好。
我有一些 VBA 代码遇到了一些麻烦，想知道是否有人可以伸出援手，好吗？
问题;
如果表 1 上有多行需要复制，我只能复制一行。我不知道如何让它搜索、匹配然后复制多行。
编辑
我希望实现的是复制列中的值；将 M、N 和 O(支付日期、支付金额、票据)放入第 2 页表格中各自的行，I、J 和 L 列(收到金额、收到日期和票据)
我的 VBA 技能有点有限啊，所以我在这方面从来没有走得太远。
更新了工作表 1 和工作表 2 的屏幕截图


编辑

Answer 1

将匹配行复制到 Excel 表 (ListObject)

注意 D2 中的一个简单公式(复制到其余的单元格)表格可以做同样的事情:

=IFERROR(INDEX(Sheet1!D:D,MATCH([@Invoice NR],Sheet1!$A:$A,0)),"")

Option Explicit

Sub UpdateTable()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
    If slRow < 2 Then Exit Sub ' no data in column range
    Dim srg As Range: Set srg = sws.Range("A2:A" & slRow) ' to lookup
    Dim scrg As Range: Set scrg = srg.EntireRow.Columns("D:G") ' to copy
    Dim cCount As Long: cCount = scrg.Columns.Count ' how many columns in 'D:G'?
    
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
    Dim dtbl As ListObject: Set dtbl = dws.ListObjects("Table1")
    
    Dim srIndex As Variant
    Dim dCell As Range
    
    ' Copy.
    For Each dCell In dtbl.ListColumns(1).DataBodyRange
        srIndex = Application.Match(dCell.Value, srg, 0) ' find a match
        If IsNumeric(srIndex) Then ' if match was found then copy if not blank
            If Application.CountBlank(scrg.Rows(srIndex)) < cCount Then
                dCell.Offset(, 3).Resize(, cCount).Value _
                    = scrg.Rows(srIndex).Value
            End If
        End If
    Next dCell
    
    ' Inform.
    MsgBox "Table updated."

End Sub