Almacenar los datos de una celda

Te he preparado este código. Tienes que grabarlo en 'ThisWorkBook' y escribir los NIFs en la celda B1 de la hoja1.
Lógicamente también puedes ajustar las celdas y nombres de página como más te guste.
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim miNIF As String
    ' Si no se ha escrito en la página 'Hoja1' en la celda B1, salimos sin hacer nada
    If Target.Address <> "$B$1" Or Sh.Name <> "Hoja1" Then Exit Sub
    ' Si está en blanco no hacemos nada
    If Target.Value = "" Then Exit Sub
    miNIF = Sh.Range("B1").Value
    ' Ponemos un formato estándar del NIF para evitar que unos se tecleen con ceros,
' otros con blancos o incluso sin la letra
ajustaFormatoNIF miNIF
    ' Si no existe, se graba y volvemos a B1
    If Not snExisteNIFteclado(miNIF) Then
        Sh.Cells(1, 2).ClearContents
        Sh.Cells(1, 2).Select
    End If
End Sub
Private Sub ajustaFormatoNIF(ByRef NIF As String)
    Dim parteIzq As String
    Dim parteNum As Long
    Dim parteDer As String
    Dim auxNIF As String
    Dim c As String
    auxNIF = UCase$(Trim$(NIF)) ' A mayúsculas sin blancos
    If auxNIF = "" Then Exit Sub
    parteIzq = "": parteDer = ""
    ' Apartamos la parte izquierda si viene con letras (para extranjeros)
    Do While auxNIF <> ""
        c = Left$(auxNIF, 1)
        If c < "A" Or c > "Z" Then Exit Do ' No es una letra
        parteIzq = parteIzq & c
        auxNIF = Trim$(Right$(auxNIF, Len(auxNIF) - 1))
    Loop
    ' Apartamos la parte derecha si viene con letras (letra del auxnif)
    Do While auxNIF <> ""
        c = Right$(auxNIF, 1)
        If c < "A" Or c > "Z" Then Exit Do ' No es una letra
        parteDer = c & parteDer
        auxNIF = Trim$(Left$(auxNIF, Len(auxNIF) - 1))
    Loop
    ' La variable auxNIF debería contener un número. Si es así la estructura
' era correcta y podemos devolver el NIF formateado
    If IsNumeric(NIF) Then
        parteNum = Val(NIF)
        If parteDer = "" Then ' No viene la letra
            parteDer = calculaLetraNIF(parteNum)
        End If
        NIF = parteIzq & Format$(parteNum, "00000000") & parteDer
    End If
End Sub
Private Function calculaLetraNIF(ByVal numDNI As Long) As String
    Const letrasNIF = "TRWAGMYFPDXBNJZSQVHLCKE"
    Dim n As Integer
    n = numDNI Mod 23 + 1
    calculaLetraNIF = Mid$(letrasNIF, n, 1)
End Function
Function snExisteNIFteclado(ByVal NIF As String) As Boolean
    Dim maxLin As Long
    Dim i As Long
    snExisteNIFteclado = False ' Hasta que se demuestre lo contrario
    ' Buscamos la última celda vacía en la columna A (la 1) de la página NIFs
maxLin = Sheets("NIFs"). Cells. SpecialCells(xlCellTypeLastCell). Row
    Do While maxLin > 1
        If Sheets("NIFs").Cells(maxLin, 1) <> "" Then Exit Do
        maxLin = maxLin - 1
    Loop
    ' Si está vacía A1... la usamos
    If Sheets("NIFs").Cells(maxLin, 1) = "" Then
        Sheets("NIFs").Cells(1, 1) = NIF
      Else
        ' Buscamos el NIF entre los ya tecleados
        For i = 1 To maxLin
            If Sheets("NIFs").Cells(i, 1) = NIF Then Exit For
        Next i
        If i <= maxLin Then ' Existe. Presentamos el valor anterior
            Sheets("NIFs").Select
            Cells(i, 1).Select
            snExisteNIFteclado = True
          Else  ' No existe. Lo añadimos al final
            Sheets("NIFs").Cells(maxLin + 1, 1) = NIF
        End If
    End If
End Function