Importing cell info from closed workbooks into new spreadsheet

P

Peter Dadswell

Good morning all

I have a small dilema, which I will try to explain for you;
I recieve approx 80 seperate spreadsheets each week from a team o
filed reps. I need to extract data from certain cells on these sheet
and collate them into a master report, preferably without opening u
each sheet seperatley.
After a bit of searching, I found this fantastic little VBA macro tha
will do exactly this, but for only one cell value. My question is, ca
this be adapted to import more than one cell from each sheet?

Sub ReadDataFromAllWorkbooksInFolder()
Dim FolderName As String, wbName As String, r As Long, cValue A
Variant
Dim wbList() As String, wbCount As Integer, i As Integer
FolderName = "C:\Link Reports"
' create list of workbooks in foldername
wbCount = 0
wbName = Dir(FolderName & "\" & "*.xls")
While wbName <> ""
wbCount = wbCount + 1
ReDim Preserve wbList(1 To wbCount)
wbList(wbCount) = wbName
wbName = Dir
Wend
If wbCount = 0 Then Exit Sub
' get values from each workbook
r = 0
For i = 1 To wbCount
r = r + 1
cValue = GetInfoFromClosedFile(FolderName, wbList(i), "LIAR"
"C131")
Cells(r, 1).Formula = wbList(i)
Cells(r, 2).Formula = cValue
Next i
End Sub
Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
If Dir(wbPath & "\" & wbName) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function


What I get from this code is, in column A are all of the file name
from the "Link Reports" folder, and in column B are the values fro
cell C131. Is it possible to have another cell value in column C etc
etc.

Many thanks in advance for any suggestions you have.
 
T

Tom Ogilvy

Just adjust
sCells = Array("C131","F23","G99")
to list the cells.

Sub ReadDataFromAllWorkbooksInFolder()
Dim FolderName As String, wbName As String
Dim r As Long, cValue As Variant, sCells as Variant
Dim wbList() As String, wbCount As Integer, i As Integer
Dim kk as Long
FolderName = "C:\Link Reports"
' create list of workbooks in foldername
sCells = Array("C131","F23","G99")
wbCount = 0
wbName = Dir(FolderName & "\" & "*.xls")
While wbName <> ""
wbCount = wbCount + 1
ReDim Preserve wbList(1 To wbCount)
wbList(wbCount) = wbName
wbName = Dir
Wend
If wbCount = 0 Then Exit Sub
' get values from each workbook
r = 0
For i = 1 To wbCount
r = r + 1
Cells(r, 1).Formula = wbList(i)
for kk = lbound(sCells) to ubound(sCells)
cValue = GetInfoFromClosedFile(FolderName, _
wbList(i), "LIAR", sCells(kk))
Cells(r, kk).Formula = cValue
Next i
End Sub

Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
If Dir(wbPath & "\" & wbName) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function

--
Regards,
Tom Ogilvy


Peter Dadswell > said:
Good morning all

I have a small dilema, which I will try to explain for you;
I recieve approx 80 seperate spreadsheets each week from a team of
filed reps. I need to extract data from certain cells on these sheets
and collate them into a master report, preferably without opening up
each sheet seperatley.
After a bit of searching, I found this fantastic little VBA macro that
will do exactly this, but for only one cell value. My question is, can
this be adapted to import more than one cell from each sheet?

Sub ReadDataFromAllWorkbooksInFolder()
Dim FolderName As String, wbName As String, r As Long, cValue As
Variant
Dim wbList() As String, wbCount As Integer, i As Integer
FolderName = "C:\Link Reports"
' create list of workbooks in foldername
wbCount = 0
wbName = Dir(FolderName & "\" & "*.xls")
While wbName <> ""
wbCount = wbCount + 1
ReDim Preserve wbList(1 To wbCount)
wbList(wbCount) = wbName
wbName = Dir
Wend
If wbCount = 0 Then Exit Sub
' get values from each workbook
r = 0
For i = 1 To wbCount
r = r + 1
cValue = GetInfoFromClosedFile(FolderName, wbList(i), "LIAR",
"C131")
Cells(r, 1).Formula = wbList(i)
Cells(r, 2).Formula = cValue
Next i
End Sub
Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
If Dir(wbPath & "\" & wbName) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function


What I get from this code is, in column A are all of the file names
from the "Link Reports" folder, and in column B are the values from
cell C131. Is it possible to have another cell value in column C etc.
etc.

Many thanks in advance for any suggestions you have.

P
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top