Creating a unique list of Cost Codes in Col. A from all worksheets in all workbooks in folder X

[u473]

How do I create in a new Workbook, a unique list of Cost Codes in Col.
A from all worksheets in all workbooks in folder X. , in a grid
format to be able to detect less used codes as follows:

Code WBA-Sh1 WBA-Sh2 WBB-Sh1 WBB-Sh2 WBB-Sh3 Total
X 1 1
1 3
Y 1 1
1 1 4
Z 1
1 2
WBB-Sh3 = Workbook B Sheet 3
Thank you again for the help to all the Gurus.
Celeste

 

[Guest]

The code below should work

Put the codes you want to look up in the new workbook in column A starting
in row 2. The macro also will go in the new workbook. Change Mypath to the
appropriate path. the code will automatically put the workbook name and
worksheet in the first row for each sheet it counts. The code uses the
worksheet function Countif to get the totals.


Sub addcostcodes()

Const MyPath = "c:\temp"

With ThisWorkbook.Sheets("sheet1")
Sh1Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
ColumnCount = 2
First = True
Do
If First = True Then
Filename = Dir(MyPath & "\*.xls")
First = False
Else
Filename = Dir()
End If
If Filename <> "" Then

Workbooks.Open MyPath & "\" & Filename
For Each ws In ActiveWorkbook.Worksheets
.Cells(1, ColumnCount) = _
ActiveWorkbook.Name & " - " & _
ActiveSheet.Name
Lastrow = ws.Cells(Rows.Count, "A"). _
End(xlUp).Row
Set SearchRange = Range("A2:A" & Lastrow)

For Sh1rowCount = 2 To Sh1Lastrow
costcode = .Range("A" & Sh1rowCount).Value
Count = WorksheetFunction.CountIf(SearchRange, costcode)
.Cells(Sh1rowCount, ColumnCount) = Count
Next Sh1rowCount
ColumnCount = ColumnCount + 1
Next ws
Workbooks(Filename).Close
End If
Loop While Filename <> ""
End With
End Sub