Try this...

Sub search()
    
    Dim listVals As Variant
    Dim dataVals As Variant
    Dim i As Long, j As Long, k As Long
    
    listVals = Sheets("Sheet1").Range("A1").CurrentRegion.Resize(, 14).Value
    dataVals = Sheets("Sheet2").Range("A1").CurrentRegion.Value
    
    With CreateObject("Scripting.Dictionary")
        For i = LBound(listVals, 1) To UBound(listVals, 1)
            .Item(listVals(i, 1)) = i
        Next i
        
        For i = LBound(dataVals, 1) To UBound(dataVals, 1)
            If .Exists(dataVals(i, 1)) Then
                j = .Item(dataVals(i, 1))
                For k = 1 To 7
                    listVals(j, k + 7) = dataVals(i, k)
                Next k
            End If
        Next i
        
        Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(listVals, 1), 14).Value = listVals
    End With
            
End Sub