Modificación de macro para expandir a varias celdas

Lo que busco es modificar esta macro expandiéndola a varias celdas perfeccionandola, la primer macro listnums hace el trabajo de expandir pero no me da todas las coincidencias posibles y la macro coincidencias si hace bien su trabajo como puedo hacer para que se pueda expandir como la primer macro y me de todas las coincidencias posibles como la segunda macro anexo macros

Sub ListaNums()
'---- Variables modificables:
'=== JHON, modifica estos datos de acuerdo a tu planilla:
RangoNum = "Z1" 'celda inicial donde están los números a analizar
RangoBusq = "F1:GL40"
'CeldaDest = "C1" 'celda a partir de la cual listar los valores coincidentes
ElColor = 20 'color a dar a las celdas con coincidencias. Cero para que quede en blanco
Cifras = 2 ' cantidad cifras considerar para comparar <<<<<
'---- fin Variables
'
'---- inicio de rutina:
'

'limpia datos bajo las columnas
Range(Range(RangoNum).Offset(1, 0), Range(RangoNum).Offset(60000, 150)).ClearContents

'coloca mensaje de cantidad de cifras usadas:

Range(RangoNum).Offset(1, -1).Value = "Coincidencias tomadas de a " & Cifras & "cifra" & IIf(Cifras > 1, "s", "")
Range(RangoNum).Offset(1, -1).HorizontalAlignment = xlRight

Set RangoNums = Range(RangoNum, Range(RangoNum).Offset(, Range(RangoNum).CurrentRegion.Columns.Count - 1))
RangoNums.Interior.ColorIndex = 0
col = 0
For Each Numero In RangoNums
Numero.Interior.ColorIndex = ElColor
Application.ScreenUpdating = False
fila = 1
If Len(Numero) Then
For Each valor In Range(RangoBusq)
If valor > 0 Then
For pos = 1 To Len(valor)
CifraV = Mid(valor, pos, Cifras)
CifraN = Mid(Numero, pos, Cifras)
If Len(CifraV) = Cifras Then
If CifraV = CifraN Then
Range(RangoNum).Offset(fila, col).Value = valor
valor.Interior.ColorIndex = ElColor
fila = fila + 1
cont = cont + 1
Exit For
End If
Else
Exit For
End If
Next
End If
Next
End If
col = col + 1
Application.ScreenUpdating = True
Next

ElMensaje = IIf(cont = 0, "NO SE ENCONTRÓ NUMERO PARA AGREGAR", "Cantidad Total de números agregados " _
& cont & " número" & IIf(cont > 1, "s", "") & Chr(10) & "a una lista de " & linea & " números")
ElTitulo = "TERMINADO!"
MsgBox ElMensaje, vbInformation, ElTitulo

Set RangoNum = Nothing
End Sub

Sub coincidencias()

Dim n As Range
Dim lookup

'se solicita ingreso del nro de 4 dígitos
lookup = Format(Val(InputBox("ingrese NUMERO de referencia", "BUSQUEDA DE COINCIDENCIAS")), "0000")
If Len(lookup) <> 4 Then
MsgBox "Número no válido.", , "ERROR"
Exit Sub
End If
'se guarda en AH1 y se da formato a la celda
With [AH1]
.Value = lookup
.NumberFormat = "0000"
.Font.Bold = True
.HorizontalAlignment = xlLeft
.Interior.ColorIndex = 44 '(naranja)
End With
'se recorre el rango buscando las 6 coincidencias
'se limpia la col AG
Columns("AG:AG").Clear
x = 2
For Each n In Range("A1:AE44")
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 = 4
'se agrega el nro a la col AG
Range("AG" & x) = n
x = x + 1
Else 'opcional quitar color a los no coincidentes.
n.Interior.Color = xlNone
End If
Next n
MsgBox "Fin del proceso.", , "INFORMACIÓN"
End Sub