[COLOR="Navy"]Sub[/COLOR] MG16Jul46
[COLOR="Navy"]Dim[/COLOR] sht [COLOR="Navy"]As[/COLOR] Worksheet, Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] sht [COLOR="Navy"]In[/COLOR] Worksheets
c = c + 1
[COLOR="Navy"]If[/COLOR] c > 5 [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
[COLOR="Navy"]With[/COLOR] sht
[COLOR="Navy"]Set[/COLOR] Rng = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
Dic.Add Dn.Value, c
[COLOR="Navy"]Else[/COLOR]
[COLOR="Navy"]If[/COLOR] InStr(Dic(Dn.Value), c) = 0 [COLOR="Navy"]Then[/COLOR] Dic(Dn.Value) = Dic(Dn.Value) & c
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Next[/COLOR] sht
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant
Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Master"
[COLOR="Navy"]Set[/COLOR] sht = ActiveSheet
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
[COLOR="Navy"]If[/COLOR] Dic(K) = 12345 [COLOR="Navy"]Then[/COLOR]
n = n + 1
Sheets("Master").Cells(n, "A") = K
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]