A continuación la macro para el rango solicitado.
Sub coincidencias_vs() 'coincide con nros ubicados en rango AA1:AZ1
'x Elsamatilde
Dim n As Range
Dim lookup
Application.ScreenUpdating = False
'se recorre rango AA1:AZ1, limpiando resultados anteriores
filx = [AA1].CurrentRegion.Rows.Count
Range("AA2:AZ" & filx).Clear
'se quita color al rango F1:V40
[F1:V40].Interior.Color = xlNone
[AA1].Select
While ActiveCell <> ""
lookup = ActiveCell.Value
'si el dato no es de 4 caracteres continúa con la sgte col.
If Len(lookup) <> 4 Then
MsgBox "Número no válido. Se continúa con el siguiente.", , "ERROR"
GoTo sigo
End If
'se recorre el rango buscando las 6 coincidencias
'se colocan resultados en la misma col a partir de fila 2
colx = ActiveCell.Column
x = 2
For Each n In Range("F1:V40")
If n = lookup Or Left(n.Value, 2) = Left(lookup, 2) Or Right(n.Value, 2) = Right(lookup, 2) Or _
(Left(n.Value, 1) = Left(lookup, 1) And Right(n.Value, 1) = Right(lookup, 1)) Or _
(Left(n.Value, 1) = Left(lookup, 1) And Mid(n.Value, 3, 1) = Mid(lookup, 3, 1)) Or _
(Mid(n.Value, 2, 1) = Mid(lookup, 2, 1) And Right(n.Value, 1) = Right(lookup, 1)) Or _
(Mid(n.Value, 2, 1) = Mid(lookup, 2, 1) And Mid(n.Value, 3, 1) = Mid(lookup, 3, 1)) Then
n.Interior.ColorIndex = 44
'se agrega el nro a la col Y
Cells(x, colx) = n
x = x + 1
Else 'opcional quitar color a los no coincidentes.
'n.Interior.Color = xlNone 'no se quita mientras dure el proceso
End If
Next n
sigo:
'se pasa a la celda de la sgte columna y repite el bucle
ActiveCell.Offset(0, 1).Select
Wend
[AA1].Select
MsgBox "Fin del proceso.", , "INFORMACIÓN"
End Sub
Envío libro a tu correo.