Get data from all workbooks in a folder. Paste into my worksheet.

G

Guest

Thanks in advance for any help you can give me.

I have a need for a function to copy "certain data" from each file in a
folder. This folder gets bigger every week with new workbooks. The "certain
data is always in the same cells in each workbook because each file is made
from a template I created. However, they are in non-adjacent cells in my
worksheet.

I tried using some code from Ron de Bruin (http://www.rondebruin.nl/fso) but
it did not give me the results I was looking for. I was unable to figure out
the pieces of the code I need because I do not understand it all. It had to
be a range of data or all of the data. It also created a new worksheet, I
just want the data to come into the worksheet in which I ran the code.

What I need to know :
The way to run a loop through all the folders in my path.
Open or get the data from each workbook.
Copy the twelve data points I need from each one.
Place the data in a row my worksheet.
Go to the next workbook in my folder.
Copy the same twelve data points.
Find the next empty row.
Place the data in that row.
So on and so forth until all data is captured.

Any suggestions or help?
 
O

Otto Moehrbach

Jeremy
A function will not do what you want. You will need VBA. Something
like the following. Note that the code to do the actual copying/pasting
goes in the code in place of the MsgBox. Substitute your actual path in
place of the "Temp" folder. Please post back if you need more. HTH Otto
Sub AllFolderFiles()

Dim wb As Workbook

Dim TheFile As String

Dim MyPath As String

MyPath = "C:\Temp"

ChDir MyPath

TheFile = Dir("*.xls")

Do While TheFile <> ""

Set wb = Workbooks.Open(MyPath & "\" & TheFile)

MsgBox wb.FullName

wb.Close

TheFile = Dir

Loop

End Sub
 
G

Guest

Ron,

I was able to get this summary code to work for me. However, when I run
this code it pulls up the Application.GetOpenFileName and has me go through
all paths, then select each individual file. (Well, I select the top file,
hold shift, and then select the bottom file...I know not to go through and
hit each one individually)

Is there a way I can just write into the code to open this set path (this
doesn't change) and select all of the workbooks in the folder without opening
the getopenfilename box. Thanks for your help.
 
R

Ron de Bruin

Hi Jeremy

Test this one for the files in
MyPath = "C:\Users\Ron\test"


Sub Summary_cells_from_Different_Workbooks_Test()
Dim SummWks As Worksheet
Dim ColNum As Integer
Dim myCell As Range, Rng As Range
Dim RwNum As Long, FNum As Long
Dim ShName As String, PathStr As String
Dim SheetCheck As String, JustFileName As String
Dim JustFolder As String
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String

'Sheet name in each workbook and range
ShName = "Sheet1" '<---- Change
Set Rng = Range("A1,D5:E5,Z10") '<---- Change

'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron\test"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
FNum = 0
Do While FilesInPath <> ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop


With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Add a new workbook with one sheet for the Summary
Set SummWks = Workbooks.Add(1).Worksheets(1)

'The links to the first workbook will start in row 2
RwNum = 1

For FNum = LBound(MyFiles) To UBound(MyFiles)
ColNum = 1
RwNum = RwNum + 1
JustFileName = MyFiles(FNum)
JustFolder = MyPath

'copy the workbook name in column A
SummWks.Cells(RwNum, 1).Value = JustFileName

'build the formula string
JustFileName = WorksheetFunction.Substitute(JustFileName, "'", "''")
PathStr = "'" & JustFolder & "[" & JustFileName & "]" & ShName & "'!"

On Error Resume Next
SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))
If Err.Number <> 0 Then
'If the sheet not exist in the workbook the row color will be Yellow.
SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1) _
.Interior.Color = vbYellow
Else
For Each myCell In Rng.Cells
ColNum = ColNum + 1
SummWks.Cells(RwNum, ColNum).Formula = _
"=" & PathStr & myCell.Address
Next myCell
End If
On Error GoTo 0
Next FNum

' Use AutoFit to set the column width in the new workbook
SummWks.UsedRange.Columns.AutoFit

MsgBox "The Summary is ready, save the file if you want to keep it"

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
 
G

Guest

Ron,

I had tried that one before, only problem is that it creates it as sheet one
in a new workbook. I have other macros that run after the file is created.
That is why the other was was working so well for me.

Like I said, the other one is working great for me except the fact that it
does not remember the open from file path and I dont know how to get it to go
and select every file that is in the folder. Many of my users will not know
the file path.

Is there any code I can add to make the other version do the same as this
one did. This one I was able to add my file path in the vb code and it
didn't make me select everyworkbook.

Thanks
Jeremy
Ron de Bruin said:
Hi Jeremy

Test this one for the files in
MyPath = "C:\Users\Ron\test"


Sub Summary_cells_from_Different_Workbooks_Test()
Dim SummWks As Worksheet
Dim ColNum As Integer
Dim myCell As Range, Rng As Range
Dim RwNum As Long, FNum As Long
Dim ShName As String, PathStr As String
Dim SheetCheck As String, JustFileName As String
Dim JustFolder As String
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String

'Sheet name in each workbook and range
ShName = "Sheet1" '<---- Change
Set Rng = Range("A1,D5:E5,Z10") '<---- Change

'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron\test"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
FNum = 0
Do While FilesInPath <> ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop


With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Add a new workbook with one sheet for the Summary
Set SummWks = Workbooks.Add(1).Worksheets(1)

'The links to the first workbook will start in row 2
RwNum = 1

For FNum = LBound(MyFiles) To UBound(MyFiles)
ColNum = 1
RwNum = RwNum + 1
JustFileName = MyFiles(FNum)
JustFolder = MyPath

'copy the workbook name in column A
SummWks.Cells(RwNum, 1).Value = JustFileName

'build the formula string
JustFileName = WorksheetFunction.Substitute(JustFileName, "'", "''")
PathStr = "'" & JustFolder & "[" & JustFileName & "]" & ShName & "'!"

On Error Resume Next
SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))
If Err.Number <> 0 Then
'If the sheet not exist in the workbook the row color will be Yellow.
SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1) _
.Interior.Color = vbYellow
Else
For Each myCell In Rng.Cells
ColNum = ColNum + 1
SummWks.Cells(RwNum, ColNum).Formula = _
"=" & PathStr & myCell.Address
Next myCell
End If
On Error GoTo 0
Next FNum

' Use AutoFit to set the column width in the new workbook
SummWks.UsedRange.Columns.AutoFit

MsgBox "The Summary is ready, save the file if you want to keep it"

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


Ron de Bruin said:
Hi Jeremy

Late here, but I will post a example tomorrow after work
Click to expand...
Click to expand...
 
R

Ron de Bruin

You can change this

'Add a new workbook with one sheet for the Summary
Set SummWks = Workbooks.Add(1).Worksheets(1)


to

Set SummWks = Thisworkbook.Worksheets.Add

Then it will create a new sheet in your workbook




--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


Jeremy R. said:
Ron,

I had tried that one before, only problem is that it creates it as sheet one
in a new workbook. I have other macros that run after the file is created.
That is why the other was was working so well for me.

Like I said, the other one is working great for me except the fact that it
does not remember the open from file path and I dont know how to get it to go
and select every file that is in the folder. Many of my users will not know
the file path.

Is there any code I can add to make the other version do the same as this
one did. This one I was able to add my file path in the vb code and it
didn't make me select everyworkbook.

Thanks
Jeremy
Ron de Bruin said:
Hi Jeremy

Test this one for the files in
MyPath = "C:\Users\Ron\test"


Sub Summary_cells_from_Different_Workbooks_Test()
Dim SummWks As Worksheet
Dim ColNum As Integer
Dim myCell As Range, Rng As Range
Dim RwNum As Long, FNum As Long
Dim ShName As String, PathStr As String
Dim SheetCheck As String, JustFileName As String
Dim JustFolder As String
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String

'Sheet name in each workbook and range
ShName = "Sheet1" '<---- Change
Set Rng = Range("A1,D5:E5,Z10") '<---- Change

'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron\test"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
FNum = 0
Do While FilesInPath <> ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop


With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Add a new workbook with one sheet for the Summary
Set SummWks = Workbooks.Add(1).Worksheets(1)

'The links to the first workbook will start in row 2
RwNum = 1

For FNum = LBound(MyFiles) To UBound(MyFiles)
ColNum = 1
RwNum = RwNum + 1
JustFileName = MyFiles(FNum)
JustFolder = MyPath

'copy the workbook name in column A
SummWks.Cells(RwNum, 1).Value = JustFileName

'build the formula string
JustFileName = WorksheetFunction.Substitute(JustFileName, "'", "''")
PathStr = "'" & JustFolder & "[" & JustFileName & "]" & ShName & "'!"

On Error Resume Next
SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))
If Err.Number <> 0 Then
'If the sheet not exist in the workbook the row color will be Yellow.
SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1) _
.Interior.Color = vbYellow
Else
For Each myCell In Rng.Cells
ColNum = ColNum + 1
SummWks.Cells(RwNum, ColNum).Formula = _
"=" & PathStr & myCell.Address
Next myCell
End If
On Error GoTo 0
Next FNum

' Use AutoFit to set the column width in the new workbook
SummWks.UsedRange.Columns.AutoFit

MsgBox "The Summary is ready, save the file if you want to keep it"

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


Ron de Bruin said:
Hi Jeremy

Late here, but I will post a example tomorrow after work


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


Ron,

I was able to get this summary code to work for me. However, when I run
this code it pulls up the Application.GetOpenFileName and has me go through
all paths, then select each individual file. (Well, I select the top file,
hold shift, and then select the bottom file...I know not to go through and
hit each one individually)

Is there a way I can just write into the code to open this set path (this
doesn't change) and select all of the workbooks in the folder without opening
the getopenfilename box. Thanks for your help.

:

hi Jeremy

However, they are in non-adjacent cells

Try this
http://www.rondebruin.nl/summary2.htm


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


Thanks in advance for any help you can give me.

I have a need for a function to copy "certain data" from each file in a
folder. This folder gets bigger every week with new workbooks. The "certain
data is always in the same cells in each workbook because each file is made
from a template I created. However, they are in non-adjacent cells in my
worksheet.

I tried using some code from Ron de Bruin (http://www.rondebruin.nl/fso) but
it did not give me the results I was looking for. I was unable to figure out
the pieces of the code I need because I do not understand it all. It had to
be a range of data or all of the data. It also created a new worksheet, I
just want the data to come into the worksheet in which I ran the code.

What I need to know :
The way to run a loop through all the folders in my path.
Open or get the data from each workbook.
Copy the twelve data points I need from each one.
Place the data in a row my worksheet.
Go to the next workbook in my folder.
Copy the same twelve data points.
Find the next empty row.
Place the data in that row.
So on and so forth until all data is captured.

Any suggestions or help?
Click to expand...
Click to expand...
Click to expand...
 
G

Guest

Ron,

Thanks for the follow-up help. It is working great thanks.

Jeremy

Ron de Bruin said:
You can change this

'Add a new workbook with one sheet for the Summary
Set SummWks = Workbooks.Add(1).Worksheets(1)


to

Set SummWks = Thisworkbook.Worksheets.Add

Then it will create a new sheet in your workbook




--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


Jeremy R. said:
Ron,

I had tried that one before, only problem is that it creates it as sheet one
in a new workbook. I have other macros that run after the file is created.
That is why the other was was working so well for me.

Like I said, the other one is working great for me except the fact that it
does not remember the open from file path and I dont know how to get it to go
and select every file that is in the folder. Many of my users will not know
the file path.

Is there any code I can add to make the other version do the same as this
one did. This one I was able to add my file path in the vb code and it
didn't make me select everyworkbook.

Thanks
Jeremy
Ron de Bruin said:
Hi Jeremy

Test this one for the files in
MyPath = "C:\Users\Ron\test"


Sub Summary_cells_from_Different_Workbooks_Test()
Dim SummWks As Worksheet
Dim ColNum As Integer
Dim myCell As Range, Rng As Range
Dim RwNum As Long, FNum As Long
Dim ShName As String, PathStr As String
Dim SheetCheck As String, JustFileName As String
Dim JustFolder As String
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String

'Sheet name in each workbook and range
ShName = "Sheet1" '<---- Change
Set Rng = Range("A1,D5:E5,Z10") '<---- Change

'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron\test"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
FNum = 0
Do While FilesInPath <> ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop


With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Add a new workbook with one sheet for the Summary
Set SummWks = Workbooks.Add(1).Worksheets(1)

'The links to the first workbook will start in row 2
RwNum = 1

For FNum = LBound(MyFiles) To UBound(MyFiles)
ColNum = 1
RwNum = RwNum + 1
JustFileName = MyFiles(FNum)
JustFolder = MyPath

'copy the workbook name in column A
SummWks.Cells(RwNum, 1).Value = JustFileName

'build the formula string
JustFileName = WorksheetFunction.Substitute(JustFileName, "'", "''")
PathStr = "'" & JustFolder & "[" & JustFileName & "]" & ShName & "'!"

On Error Resume Next
SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))
If Err.Number <> 0 Then
'If the sheet not exist in the workbook the row color will be Yellow.
SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1) _
.Interior.Color = vbYellow
Else
For Each myCell In Rng.Cells
ColNum = ColNum + 1
SummWks.Cells(RwNum, ColNum).Formula = _
"=" & PathStr & myCell.Address
Next myCell
End If
On Error GoTo 0
Next FNum

' Use AutoFit to set the column width in the new workbook
SummWks.UsedRange.Columns.AutoFit

MsgBox "The Summary is ready, save the file if you want to keep it"

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


Hi Jeremy

Late here, but I will post a example tomorrow after work


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


Ron,

I was able to get this summary code to work for me. However, when I run
this code it pulls up the Application.GetOpenFileName and has me go through
all paths, then select each individual file. (Well, I select the top file,
hold shift, and then select the bottom file...I know not to go through and
hit each one individually)

Is there a way I can just write into the code to open this set path (this
doesn't change) and select all of the workbooks in the folder without opening
the getopenfilename box. Thanks for your help.

:

hi Jeremy

However, they are in non-adjacent cells

Try this
http://www.rondebruin.nl/summary2.htm


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


Thanks in advance for any help you can give me.

I have a need for a function to copy "certain data" from each file in a
folder. This folder gets bigger every week with new workbooks. The "certain
data is always in the same cells in each workbook because each file is made
from a template I created. However, they are in non-adjacent cells in my
worksheet.

I tried using some code from Ron de Bruin (http://www.rondebruin.nl/fso) but
it did not give me the results I was looking for. I was unable to figure out
the pieces of the code I need because I do not understand it all. It had to
be a range of data or all of the data. It also created a new worksheet, I
just want the data to come into the worksheet in which I ran the code.

What I need to know :
The way to run a loop through all the folders in my path.
Open or get the data from each workbook.
Copy the twelve data points I need from each one.
Place the data in a row my worksheet.
Go to the next workbook in my folder.
Copy the same twelve data points.
Find the next empty row.
Place the data in that row.
So on and so forth until all data is captured.

Any suggestions or help?
Click to expand...
Click to expand...
Click to expand...
 

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

Similar Threads

Excel Copy cells from one worksheet to another workseet - increment row & do again 0
Import multiple workbooks to current workbook in specified row number 0
How to reference a cell from anther workbook without opening it 0
Excel How to capture data to a specified excel sheet(first workbook) of two different workbooks from the 0
How to append data from different sheet and different workbook? 2
VBA code for pasting links -- modifying RDB code for summary workbook 10
Collate data from multiple workbooks into one worksheet 0
Ron de Bruin - Merge cells from all worksheets 0

Top