excel multiple files saved in 1 file

[seanyeap]

Dear Sir/Madam,
I need to know if multiple excel files with several sheets can be save
into 1 file.
I just want to save my time as there are 600 files! Thks in advance.

Regards,
sea

 

[Otto Moehrbach]

Don't really know what you want to do. You can copy sheets from multiple
files into one file to create one file that now has all the sheets of the
other files. Is that what you want? HTH Otto

 

[Dave Peterson]

And if there are 600 files (=workbooks), how many worksheets would you end up in
that giant workbook?

Even if excel could handle all the data, I'm sure I couldn't navagate a workbook
that large efficiently.

 

[seanyeap]

Dear Sir/Madam,
Actually, my intention is to extract data from the workbook which
contains 3 sheets. And I want to copy all the content into 1 row in a
new workbook to create a database. So that I can do sorting,filter &
etc. Eventually,I'll have 600 rows in a sheet, that's fine with me. Te
problem is that there are 600 workbooks to work with. Pls help.

Regards,
sean

 

[Dave Peterson]

I think it you'll get a better answer if you answer a couple of questions:

#1. Are all the workbooks in a folder by themselves--so the all the files in
that folder can be processed--or can you isolate all 600 workbooks by naming
convention???

#2. What do you want to save from each worksheet in each of the workbooks? If
it's always the first row, it's one solution. If you want to save values from
certain addresses, that's another solution.

 

[seanyeap]

Dear Dave Peterson,
Sorry for the late reply as I've been trying to figure out a way.
However, I failed. To answer your questions.

Yes,all workbooks are in one same folder

I want to "copy" data from each worksheet in each of the workbooks
which data is not in a first row.

Basically, I want something like the following, so that data from the
abc.xls will be copied to my new worksheet . How do I create a function
or macro to run for 600 files? Frankly,I don't mind to open 600 times!
Pls help.

ActiveCell.FormulaR1C1 = "=SUM([abc.xls]Sheet1!R7C1)"
Range("B1").Select
ActiveCell.FormulaR1C1 = "=SUM([abc.xls]Sheet1!R10C1)"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=SUM([abc.xls]Sheet2!R3C1)"
Range("D1").Select
ActiveCell.FormulaR1C1 = "=SUM([abc.xls]Sheet2!R8C4)"
Range("E1").Select
ActiveCell.FormulaR1C1 = "=SUM([abc.xls]Sheet3!R8C4)"
Range("F1").Select
ActiveCell.FormulaR1C1 = "=SUM([abc.xls]Sheet3!R11C7)"
Range("F2").Select
Windows("abc.xls").Activate
ActiveWindow.Close
Sheets("Sheet1").Select
End Sub

Regards,
sean

 

[Dave Peterson]

This uses John Walkenbach's routine to retrieve values from a closed workbook.
You can find it here:
http://j-walk.com/ss/excel/eee/eee009.txt
Look for either: GetDataFromClosedFile or GetValue.

And I put the name of the workbook in column A. I think you'd want to know
where the data came from.

But if you don't need it, just run the macro and then delete column A.

Option Explicit
Option Base 0
Sub testme01()

Application.ScreenUpdating = False

Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim logWks As Worksheet
Dim oRow As Long
Dim addrCtr As Long
Dim myColOffset As Long
Dim tempVal As Variant

Dim myAddressesToRetrieve As Variant
Dim mySheetsToRetrieve As Variant

myAddressesToRetrieve = Array("a7", "a10", "A3", "D8", "D8", "G11")
mySheetsToRetrieve = Array("sheet1", "sheet1", "sheet2", "sheet2", "sheet3",
"sheet3")

If UBound(myAddressesToRetrieve) <> UBound(mySheetsToRetrieve) Then
MsgBox "design error!"
Exit Sub
End If

'change to point at the folder to check
myPath = "c:\my documents\excel\test"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

Set logWks = Workbooks.Add(1).Worksheets(1)

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
oRow = 1
For fCtr = LBound(myFiles) To UBound(myFiles)
logWks.Cells(oRow, "A").Resize(2).Value = "'" & myFiles(fCtr)
For addrCtr = LBound(myAddressesToRetrieve) _
To UBound(myAddressesToRetrieve)
tempVal = GetValue(myPath, _
myFiles(fCtr), _
mySheetsToRetrieve(addrCtr), _
myAddressesToRetrieve(addrCtr))

If addrCtr = 3 Then
oRow = oRow + 1
End If

If addrCtr > 2 Then
myColOffset = addrCtr - 3
Else
myColOffset = addrCtr
End If

logWks.Cells(oRow, "b").Offset(0, myColOffset).Value = tempVal

Next addrCtr
oRow = oRow + 1
Next fCtr
End If

Application.ScreenUpdating = True

End Sub

Private Function GetValue(path, file, sheet, range_ref)

'from John Walkenbach's site:
'http://j-walk.com/ss/excel/eee/eee009.txt
'Look for either: GetDataFromClosedFile or GetValue.
'Retrieves a value from a closed workbook

Dim arg As String

'Make sure the file exists
If Right(path, 1) <> "\" Then path = path & "\"

If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If

'Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(range_ref).Range("A1").Address(, , xlR1C1)

'Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)

End Function

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

Dear Dave Peterson,
Sorry for the late reply as I've been trying to figure out a way.
However, I failed. To answer your questions.

Yes,all workbooks are in one same folder

I want to "copy" data from each worksheet in each of the workbooks
which data is not in a first row.

Basically, I want something like the following, so that data from the
abc.xls will be copied to my new worksheet . How do I create a function
or macro to run for 600 files? Frankly,I don't mind to open 600 times!
Pls help.

ActiveCell.FormulaR1C1 = "=SUM([abc.xls]Sheet1!R7C1)"
Range("B1").Select
ActiveCell.FormulaR1C1 = "=SUM([abc.xls]Sheet1!R10C1)"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=SUM([abc.xls]Sheet2!R3C1)"
Range("D1").Select
ActiveCell.FormulaR1C1 = "=SUM([abc.xls]Sheet2!R8C4)"
Range("E1").Select
ActiveCell.FormulaR1C1 = "=SUM([abc.xls]Sheet3!R8C4)"
Range("F1").Select
ActiveCell.FormulaR1C1 = "=SUM([abc.xls]Sheet3!R11C7)"
Range("F2").Select
Windows("abc.xls").Activate
ActiveWindow.Close
Sheets("Sheet1").Select
End Sub

Regards,
sean

 

[Dave Peterson]

watchout for linewrap. This should be one logical line:

mySheetsToRetrieve = Array("sheet1", "sheet1", "sheet2", "sheet2", "sheet3",
"sheet3")

just add a continuation character (space underscore):

mySheetsToRetrieve = Array("sheet1", "sheet1", "sheet2", _
"sheet2", "sheet3", "sheet3")

 

[seanyeap]

Dear Dave Peterson,
I am really thankful to you. Thanks again.

Regards,
sea

 

[seanyeap]

Dear Dave Peterson,
Sorry to trouble you again. Yeah, I'm almost there! Need you to fine
tune a bit. How do I make data "a7", "a10", "A3", "D8", "D8", "G11"
from "sheet1", "sheet1", "sheet2", "sheet2", "sheet3",
"sheet3" respectively copied to a new workbook in only ONE row?
By using your helpful code, I managed to copy all data to new workbook
in 2 rows. Pls help. Thanks a lot.

Regards,
Sean

 

[Dave Peterson]

Sorry, I misread the original message somehow! (I don't know where I got that
idea that you wanted 2 rows.)


Option Explicit
Option Base 0
Sub testme01()

Application.ScreenUpdating = False

Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim logWks As Worksheet
Dim oRow As Long
Dim addrCtr As Long
Dim tempVal As Variant

Dim myAddressesToRetrieve As Variant
Dim mySheetsToRetrieve As Variant

myAddressesToRetrieve = Array("a7", "a10", "A3", "D8", "D8", "G11")
mySheetsToRetrieve = Array("sheet1", "sheet1", _
"sheet2", "sheet2", _
"sheet3", "sheet3")

If UBound(myAddressesToRetrieve) <> UBound(mySheetsToRetrieve) Then
MsgBox "design error!"
Exit Sub
End If

'change to point at the folder to check
myPath = "c:\my documents\excel\test"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

Set logWks = Workbooks.Add(1).Worksheets(1)

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
oRow = 1
For fCtr = LBound(myFiles) To UBound(myFiles)
logWks.Cells(oRow, "A").Resize(2).Value = "'" & myFiles(fCtr)
For addrCtr = LBound(myAddressesToRetrieve) _
To UBound(myAddressesToRetrieve)
tempVal = GetValue(myPath, _
myFiles(fCtr), _
mySheetsToRetrieve(addrCtr), _
myAddressesToRetrieve(addrCtr))

logWks.Cells(oRow, "b").Offset(0, addrCtr).Value = tempVal

Next addrCtr
oRow = oRow + 1
Next fCtr
End If

Application.ScreenUpdating = True

End Sub

Private Function GetValue(path, file, sheet, range_ref)

'from John Walkenbach's site:
'http://j-walk.com/ss/excel/eee/eee009.txt
'Look for either: GetDataFromClosedFile or GetValue.
'Retrieves a value from a closed workbook

Dim arg As String

'Make sure the file exists
If Right(path, 1) <> "\" Then path = path & "\"

If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If

'Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(range_ref).Range("A1").Address(, , xlR1C1)

'Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)

End Function



Private Function GetValue(path, file, sheet, range_ref)

'from John Walkenbach's site:
'http://j-walk.com/ss/excel/eee/eee009.txt
'Look for either: GetDataFromClosedFile or GetValue.
'Retrieves a value from a closed workbook

Dim arg As String

'Make sure the file exists
If Right(path, 1) <> "\" Then path = path & "\"

If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If

'Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(range_ref).Range("A1").Address(, , xlR1C1)

'Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)

End Function

 

[seanyeap]

Dear Dave Peterson,
I still have 2 rows of file name in A1 & A2. Pls help again. Thks

Regards,
Sean

 

[Dave Peterson]

Sorry, just change this line:

logWks.Cells(oRow, "A").Resize(2).Value = "'" & myFiles(fCtr)
to
logWks.Cells(oRow, "A").Value = "'" & myFiles(fCtr)

 

[seanyeap]

Dear Dave Peterson,
Please don't say sorry, I should be saying it as I troubled you s
much. Thanks a lot.

Regards,
sea

 

[Dave Peterson]

But did it work this time????

Dear Dave Peterson,
Please don't say sorry, I should be saying it as I troubled you so
much. Thanks a lot.

Regards,
sean

 

[seanyeap]

Dear Dave Peterson,
Yes, it works so well! Thanks.

Regards,
sea

 

[Dave Peterson]

Whew! That's good.

Dear Dave Peterson,
Yes, it works so well! Thanks.

Regards,
sean

 

[seanyeap]

Dear Dave Peterson,
You r great & knowledgable, why did u learn all this?

Regards,
sea

 

[Dave Peterson]

Thanks,

I got thrown into it at work. Someone asked if it was possible to do something
in excel and I (foolishly?) said: I bet it is.

If you really meant how (instead of why), it was mostly lurking in these here
newsgroups. Reading posts by Tom Ogilvy, Chip Pearson, John Walkenbach, and
everyone else.

And then trying things to see if I could do them.

 

[seanyeap]

Dear Dave Peterson,
Yep, it was typo error, anyway,thanks a lot.

Regards,
sea