如果要将值从工作表Transaction复制到工作表Template中的不同列但相同行，可以执行以下操作

If Sheets("Transaction").Cells(lr, 17).Value = "From" Then
        Sheets("Template").Cells(lr, 4) = Sheets("Transaction").Cells(lr, 18).Value
    End If
    
    If Sheets("Transaction").Cells(lr, 17).Value = "To" Then
        Sheets("Template").Cells(lr, 6) = Sheets("Transaction").Cells(lr, 18).Value
    End If

我已经过滤了名称，所以只需将相同名称和相同编号的数据复制到其他工作表中

复制条件行

Option Explicit

Sub TransferTransactions()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Transaction")
    If sws.AutoFilterMode Then sws.AutoFilterMode = False ' turn off AutoFilter
    
    Dim slCell As Range: Set slCell = sws.Cells(sws.Rows.Count, "Q").End(xlUp)
    
    Dim slrg As Range: Set slrg = sws.Range("Q1", slCell) ' has headers
    Dim svrg As Range ' no headers
    Set svrg = slrg.EntireRow.Columns("R").Resize(slrg.Rows.Count - 1).Offset(1)
    
    Dim sCriteria As Variant: sCriteria = Array("From", "To")
    Dim dAddresses As Variant: dAddresses = Array("D8", "F8")
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("Template")
    
    Dim srg As Range
    Dim dfCell As Range
    Dim n As Long
    
    For n = LBound(Criteria) To UBound(Criteria)
        slrg.AutoFilter 1, Criteria(n)
        On Error Resume Next
            Set srg = svrg.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not srg Is Nothing Then
            Set dfCell = dws.Range(dAddresses(n))
            srg.Copy
            dfCell.PasteSpecial xlPasteValues
            Set srg = Nothing
        End If
        sws.AutoFilterMode = False
    Next n

    Application.CutCopyMode = False
    Application.Goto dws.Range("A1"), True
    
    MsgBox "Transactions transferred to the template.", vbInformation

End Sub