find unique values in different spreadsheets.

Sub kTest()
Dim FileFolder As String
Dim dic As Object, w(), v, n As Long, a, Flg As Boolean
Dim fName As String, wb As Workbook, aWB As Workbook, ws As Worksheet

Set dic = CreateObject("scripting.dictionary")
dic.comparemode = vbTextCompare
FileFolder = "C:\2007\" 'change to suit
fName = Dir(FileFolder & "Week*.xls")
ReDim w(1 To Rows.Count, 1 To 1)
With Application
    .ScreenUpdating = 0
    .EnableEvents = 0
    .DisplayAlerts = 0
End With
Set aWB = ActiveWorkbook
Flg = False
DoAgain:
Do While fName <> ""
    If fName <> aWB.Name Then
        Set wb = Workbooks.Open(Filename:=FileFolder & fName, UpdateLinks:=0)
        With wb.Sheets(1)
            a = .Range("c4", .Range("c" & Rows.Count).End(xlUp))
        End With
        For Each v In a
            If Not IsEmpty(v) Then
                If Not dic.exists(v) Then
                n = n + 1: w(n, 1) = v: dic.Add v, Nothing
            End If
        Next
        Erase a
        wb.Close False
        Set wb = Nothing
        fName = Dir()
    End If
Loop
If Flg = False Then
    FileFolder = "C:\2008\" 'change to suit
    fName = Dir(FileFolder & "Week*.xls")
    Flg = True
    GoTo DoAgain
End If
Set ws = aWB.Sheets.Add
ws.Name = "UniqueCodes"
With ws.Range("a1")
    .Value = "Unique Codes"
    .Offset(1).Resize(n).Value = w
End With
Set dic = Nothing
With Application
    .ScreenUpdating = 1
    .EnableEvents = 1
    .DisplayAlerts = 1
End With
End Sub