VBA查找（Application.Match）

Sub CreateInductionReport()
    
    ' Define constants.
    
    Const LKP_FIRST_CELL As String = "A2" ' 2.) ... here, if no match...
    Const SRC_RANGE As String = "O79:O6256" ' 1.) Lookup this...
    Const SRC_COLS As String = "P,N,K,L" ' 3.) ... copy these...
    Const DST_FIRST_CELL As String = "A2" ' 4.) ... here.
    
    ' Reference the worksheets (using code names).
    
    Dim lws As Worksheet: Set lws = Sheet1 ' Lookup
    Dim sws As Worksheet: Set sws = Sheet17 ' Source
    Dim dws As Worksheet: Set dws = Sheet2 ' Destination
    
    ' Reference the lookup range.
    
    Dim lfCell As Range: Set lfCell = lws.Range(LKP_FIRST_CELL)
    Dim llCell As Range: Set llCell = lfCell.Resize( _
        lws.Rows.Count - lfCell.Row + 1).Find("*", , xlFormulas, , , xlPrevious)
    Dim lrg As Range: Set lrg = lws.Range(lfCell, llCell)
    
    ' Reference the source range.
    
    Dim srg As Range: Set srg = sws.Range(SRC_RANGE)
    Dim slCell As Range
    Set slCell = srg.Find("*", , xlFormulas, , , xlPrevious)
    Set srg = sws.Range(srg.Cells(1), slCell)
    Dim srCount As Long: srCount = srg.Rows.Count
    
    ' Write the values from the source columns to the source jagged array.
    
    Dim sCols() As String: sCols = Split(SRC_COLS, ",") ' zero-based
    Dim cCount As Long: cCount = UBound(sCols) + 1 ' one-based
    Dim sJag(): ReDim sJag(1 To cCount)
    
    Dim c As Long
    
    For c = 1 To cCount
        sJag(c) = srg.EntireRow.Columns(sCols(c - 1)).Value
    Next c
    
    ' Write the source row indexes, of the matches of the source range
    ' in the lookup range, to the source rows array. Values with no match,
    ' the values of interest will return error values
    
    Dim srData(): srData = Application.Match(srg, lrg, 0)
    
    ' Define the destination array.
    
    Dim drCount As Long: drCount = srCount - Application.Count(srData)
    If drCount = 0 Then
        MsgBox "There are no missing values in the source worksheet.", _
            vbExclamation
        Exit Sub
    End If

    Dim dData(): ReDim dData(1 To drCount, 1 To cCount)
    
    ' Write the values from the source jagged array, not found in the lookup
    ' range i.e. defined by the error values in the source rows array,
    ' to the destination array.
    
    Dim sr As Long, dr As Long
    
    For sr = 1 To srCount
        If IsError(srData(sr, 1)) Then ' no match
            dr = dr + 1
            For c = 1 To cCount
                dData(dr, c) = sJag(c)(sr, 1)
            Next c
        'Else ' is a match; do nothing
        End If
    Next sr
    
    ' Reference the destination range.
    
    Dim dfCell As Range: Set dfCell = dws.Range(DST_FIRST_CELL)
    Dim drg As Range: Set drg = dfCell.Resize(drCount, cCount)
    
    ' Write the values from the destination array to the destination range
    ' and clear below
    
    drg.Value = dData
    drg.Resize(dws.Rows.Count - drg.Row - drCount + 1).Offset(drCount).Clear
    
    ' Inform.
    
    MsgBox "Induction report created.", vbInformation

End Sub

你不应该每次迭代都给lRow加1，因为你只想在实际添加数据时（当它通过第二个If语句时）增加它，并且lRow应该在你的Range中使用，如下所示：

lRow = lRow+1 'so you don't overwrite your last row
For i = 79 To 6256 'hardcoding like this is ill-advised; you can also use a lRow variation for this sort of thing but that's not your question right now
   If Cells(i, 15) <> "" Then
       Set s = Sheet1.Range("A1:A9000").Find(What:=Sheet17.Cells(i, 15).Value, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) 'SEARCH FOR NAME AND SUPPLIER WITHIN INDUCTION LIST
       If s Is Nothing Then 'name is not found
           Sheet2.Range("C" & lRow).Value = Sheet17.Cells(i, 11).Value 'Transfer name
           Sheet2.Range("B" & lRow).Value = Sheet17.Cells(i, 14).Value 'Transfer Role
           Sheet2.Range("D" & lRow).Value = Sheet17.Cells(i, 12).Value 'Transfer Supplier
           Sheet2.Range("A" & lRow).Value = Sheet17.Cells(i, 16).Value 'Transfer Job Number
           lRow = lRow + 1
       End If
    End If
Next i

希望这有帮助：）
ps：我刚刚注意到你清除了第2行和前面的内容，所以你可以只使用lRow = 2（没有我在你的for循环前面添加的lRow = lRow + 1）