Sub Find_Matches()
  Dim a, b, d, r&, tm
  tm = Timer
  a = Range([m2], Cells(Rows.Count, 13).End(xlUp))
  Set d = CreateObject("Scripting.Dictionary")
  For r = 1 To UBound(a): d(a(r, 1)) = 1: Next
  a = Selection: ReDim b(1 To UBound(a), 1 To 1)
  For r = 1 To UBound(a)
    If d.exists(a(r, 1)) Then b(r, 1) = "ok"
  Next
  Selection.Offset(0, 1) = b
  MsgBox Timer - tm
End Sub

Sub Test()
    Dim arrNoNCD, arrData, arrOut, LastRow As Long, iRow As Long, i As Long, iCol As Long
        
    With ActiveSheet
        If .FilterMode Then .ShowAllData
        LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
        arrNoNCD = .Range("G2:G" & LastRow).Value
        LastRow = .Cells(.Rows.Count, "AD").End(xlUp).Row
        arrData = .Range("AD2:AY" & LastRow).Value
    End With
        
    ReDim arrOut(1 To UBound(arrNoNCD), 1 To UBound(arrData, 2))
    For iRow = 1 To UBound(arrNoNCD)
        For i = 1 To UBound(arrData)
            If arrData(i, 1) = arrNoNCD(iRow, 1) Then
                For iCol = 1 To UBound(arrData, 2)
                    arrOut(iRow, iCol) = arrData(i, iCol)
                Next iCol
            End If
        Next i
    Next iRow
        
    Range("BA2").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value = arrOut
    MsgBox "Данные выведены в столбец BA", vbInformation, "Конец"
End Sub