Pull Data from multiple sheets

[KurtB]

My company keeps customer records in spreadsheets for that given
customer. Each customer spreadsheet has 12 tabs and is named by
customer number ie: OH09001 Doe and kept in a folder of the same name.
I would like to pull most of the data from each customer's spreadsheet
into a single separate spreadsheet so I can track certain information
without having to double enter.

In my customer spreadsheet I have an "information" tab with name in
a1, phone in a5 etc. I also have a "material list" tab with the
quantity of material in A and the item in B.

I want to put this into a spreadsheet like:

Customer name phone
Material Item
0809001 Doe
0809002 Smith

What is the best way to pull the information out from many
spreadsheets without having them open? I have 320 customers so I'm
thinking I need a macro but don't know where to start.

Thanks!

 

[Joel]

You will need a macro that will automatically open and close each of the 320
files.

You also will need to change the following line to the Main folder where all
the subfolders are located

Folder = "C:\temp"


I'm not sure I complete understand all your instructions. Some people use
the word FOLDER to describe different things.

From your description I assumed you had a directory on your PC with 320
subfolders. Each of the subfolders has a workbook with the same name as the
subfolder with a suffix ".xls". Some thing like this

c:\customers
1234 Doe\
1234 Doe.xls
1235 John\
1235 John.xls
1236 Mary\
1236 Mary.xls

In this example above change

from:
Folder = "C:\temp"
to:
Folder = "c:\customers"




Sub GetSubFolderSize()

Set ThisBkSht = ThisWorkbook.Sheets("Sheet1")
With ThisBkSht
.Range("A1") = "Customer"
.Range("B1") = "Name"
.Range("C1") = "Phone"
.Range("D1") = "Material"
.Range("E1") = "Item"
NewRow = 2
End With

Folder = "C:\temp"

Set fso = CreateObject _
("Scripting.FileSystemObject")

Set Folder = _
fso.GetFolder(Folder)

If Folder.subfolders.Count > 0 Then
For Each Sf In Folder.subfolders
File = Sf.Name & "\" & Sf.Name & ".xls"
FName = Dir(File)
If FName = "" Then
MsgBox ("Cannot find file : " & File)
Else
Set bk = Workbooks.Open(Filename:=File)
With bk.Sheets("Information")
Name = .Range("A1")
Phone = .Range("A5")
End With
With bk.Sheets("material list")
RowCount = 1
Do While .Range("A" & RowCount) <> ""
Quant = .Range("A" & RowCount)
Material = .Range("B" & RowCount)

With ThisBkSht
.Range("A" & NewRow) = Sf.Name
.Range("B" & NewRow) = Name
.Range("C" & NewRow) = Phone
.Range("D" & NewRow) = Quant
.Range("E" & NewRow) = Material

NewRow = NewRow + 1
End With
RowCount = RowCount + 1
Loop
End With

End If

bk.Close savechanges:=False
Next Sf
End If

End Sub