Enviar datos resaltados de amarillo a hoja 2

Tengo el siguiente código

Sub buscar_reemplazar_colorear()
Set DATOS = Range("a1:x36").CurrentRegion
Set lista = Range("al2").CurrentRegion
MATRIZ = DATOS
With lista
For i = 1 To .Rows.Count
numeros = .Cells(i, 1)
cuenta = WorksheetFunction.CountIf(DATOS, numeros)
If cuenta > 0 Then
For j = 1 To cuenta
If j = 1 Then Set busca = DATOS.Find(Format(numeros, "0000"), LookAt:=xlWhole)
If j > 1 Then Set busca = DATOS.FindNext(busca)
On Error Resume Next
celda = busca.Address
With Range(celda)
.NumberFormat = "@"
.Value = Format(lista.Cells(1, 1), "0000")
.Interior.ColorIndex = 6
.Select
End With
Next j
Else
GoTo SIGUIENTE
End If
ASK = MsgBox("DEJAR TODO COMO ESTABA?", vbYesNo, "AVISO")
If ASK = 7 Then GoTo SALIDA
Range(DATOS.Address) = MATRIZ
On Error GoTo 0
SIGUIENTE:
Next i
End With
SALIDA:
End Sub

como puedo anexarle que los numeros que resalto de amarillo lo envie a la hoja 2