Combining workbooks into one?????

  • Thread starter Thread starter ian123
  • Start date Start date
I

ian123

Hi,

I often receive data in several workbooks that i have to open and cop
to a new workbook so as to be able to evaluate the data in compariso
with each other.

Is it possible to use programming (or any other way) to simplify th
process so that on clicking a button or running a macro will collec
each of the sheets from the desired workbooks and copy them to a ne
workbook?

Any help would be much appreciate
 
Sub GetSheets()
Dim sPath as Path, i as long
Dim varr as Variant
Dim wkbk as Workbook
sPath = "C:\MyData\"
varr = ("Data1.xls", "Data2.xls", "Data3.xls")
for i = lbound(varr) to ubound(varr)
set wkbk = workbooks.open(sPath & varr(i))
wkbk.worksheets(1).Copy After:=Thisworkbook. _
Worksheets(thisworkbook.Worksheets.count)
wkbk.close SaveChanges:=False
Next
End sub

would be a simple example.
 
Thanks for the help. Unfortunately when running the macro the first
line is being rejected as "Compile Error- User Defined Type Not
Defined"

Any ideas as to where i'm going wrong?

Also the line "varr = (Data1.xls, Data2.xls") is highlighted in red and
i am informed that "Compile Error - Expected )" with the first ','
highlighted?
 
varr = ("Data1.xls", "Data2.xls", "Data3.xls")
should be
varr = Array("Data1.xls", "Data2.xls", "Data3.xls")
 
Thanks very much, that solves the 2nd of the 2 problems but
unfortunately i am still being told that the first line of code "Dim
sPath As Path, i As Long" is a compile error, user defined type is not
defined. The words "sPath As Path" are highlighted in blue.

Any advice?
 
Thanks very much, i can now get it to bring the first sheet of each book
in the range selected. Is it possible to bring all the sheets from
each of the books selected into the new book?

Once again thanks very much for your help on this - it is very much
appreciated
 
Sub GetSheets()
Dim sPath As String, i As Long
Dim varr As Variant
Dim wkbk As Workbook
sPath = "C:\MyData\"
varr = Array("Data1.xls", "Data2.xls", "Data3.xls")
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(sPath & varr(i))
wkbk.Worksheets.Copy After:=ThisWorkbook. _
Worksheets(ThisWorkbook.Worksheets.Count)
wkbk.Close SaveChanges:=False
Next
End Sub
 
Change this line:

wkbk.Worksheets(1).Copy After:=ThisWorkbook. _
Worksheets(ThisWorkbook.Worksheets.Count)

to

wkbk.Worksheets.Copy After:=ThisWorkbook. _
Worksheets(ThisWorkbook.Worksheets.Count)
 
Thats a great macro... Is there a way to tweak it so that it will
combine approx 300 xl files with different names (of a sequence) into 1
file?

Could it also be modified to put the data in the next available column
of the same sheet?


Thanks!
 
I have been monitoring this thread with considerable interest. I've
been trying to figure out what code needed after they are copied to
rename each worksheet using a numeric value that appears in cell C2 of
each sheet as the name. The value in cell C2 is unique for each
worksheet. Any help is appreciated.

The code I am using is as follows:

Sub GetSheets()
Dim sPath As String, i As Long
Dim varr As Variant
Dim wkbk As Workbook
sPath = "C:\Data\DataFiles\test\"
varr = Array("Data1.xls", "Data2.xls", "Data3.xls")
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(sPath & varr(i))
wkbk.Worksheets(6).Copy After:=ThisWorkbook. _
Worksheets(ThisWorkbook.Worksheets.Count)
wkbk.Close SaveChanges:=False
Next
End Sub
 
You're just copying one worksheet (worksheets(6))?

Maybe just rename it before you copy it. Since you're closing the workbook
without saving, it shouldn't matter:

Option Explicit
Sub GetSheets()
Dim sPath As String, i As Long
Dim varr As Variant
Dim wkbk As Workbook
sPath = "C:\Data\DataFiles\test\"
varr = Array("Data1.xls", "Data2.xls", "Data3.xls")
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(sPath & varr(i))
With wkbk.Worksheets(6)
On Error Resume Next
.Name = .Range("c2").Value
If Err.Number <> 0 Then
MsgBox .Name & " Couldn't be renamed"
Err.Clear
End If
On Error GoTo 0
.Copy After:=ThisWorkbook. _
Worksheets(ThisWorkbook.Worksheets.Count)
End With
wkbk.Close SaveChanges:=False
Next
End Sub

You may want to be a little more careful with the naming. C2 could contain what
turns out to be an invalid name--that's why the "on error" stuff.
 
Firstly, thanks to everyone for the help on this - hopefully this hel
can be extended once more.

I am very happy with the macro when bringing in 3 workbooks and i
there are 1 more or less i simply alter the code accordingly. However
there are times when i wish to combine as many as 13or 14 books - th
number varies each time.

I was therefore wondering if its possible to alter the code to bring i
as many workbooks as there are in the folder (presuming they are name
data1.xls, data 2.xls...datax.xls)

I imagine this will require some alteration to the line:
varr = Array("Data1.xls", "Data2.xls", "Data3.xls")

Alternatively i was thinking it may be possible to create a popup bo
that instructs the user to enter the number of books to be brought in
with the code for each potential option activated on input by the use
(i can only imagine this would take masses of code but as most of i
would be simply cut and pasted it might not be as time consuming as i
first appears???)

Any pointers, advice or cautionary tales would be much appreciated
 
When there's that much variation, maybe you should just ask the user (you???) to
select the workbooks to combine. (They'll have to be in the same folder,
though.)

Option Explicit
Sub GetSheets()
Dim i As Long
Dim varr As Variant
Dim wkbk As Workbook
varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)
If IsArray(varr) Then
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(varr(i))
wkbk.Worksheets.Copy After:=ThisWorkbook. _
Worksheets(ThisWorkbook.Worksheets.Count)
wkbk.Close SaveChanges:=False
Next
End If
End Sub

Notice that sData is gone. varr(i) will contain the full path to the file.

When you're prompted for the file name, you can click on the first and
ctrl-click on the subsequent to keep adding more to the list.

And if your filenames are sorted nicely, you can click on the first and
shift-click on the last.
 
Sub GetSheets()
Dim sPath As String, i As Long
Dim varr() As String
Dim wkbk As Workbook
Dim sFile As String
ReDim varr(1 To 400)
sPath = "C:\MyData\"
i = 0
sFile = Dir(sPath & "Data*.xls")
If sFile = "" Then Exit Sub
Do
i = i + 1
varr(i) = sFile
sFile = Dir()
Loop Until sFile = ""
ReDim Preserve varr(1 To i)
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(sPath & varr(i))
wkbk.Worksheets.Copy After:=ThisWorkbook. _
Worksheets(ThisWorkbook.Worksheets.Count)
wkbk.Close SaveChanges:=False
Next
End Sub
 
Sub GetSheets()
Dim sPath As String, i As Long
Dim varr() As String
Dim wkbk As Workbook
Dim sFile As String
ReDim varr(1 To 400)
sPath = "C:\Data1\"
i = 0
sFile = Dir(sPath & "Data*.xls")
If sFile = "" Then Exit Sub
Do
i = i + 1
varr(i) = sFile
sFile = Dir()
Loop Until sFile = ""
ReDim Preserve varr(1 To i)
For i = LBound(varr) To UBound(varr)
Debug.Print i, varr(i)
Set wkbk = Workbooks.Open(sPath & varr(i))
wkbk.Worksheets.Copy After:=ThisWorkbook. _
Worksheets(ThisWorkbook.Worksheets.Count)
wkbk.Close SaveChanges:=False
Next
End Sub

there are only 256 columns in a worksheet. Even if copying only 1 column
from each workbook, it would exceed capacity. Perhaps a few more specifics
on what you want copied. As written it copies all worksheets - not just the
data on the worksheets.
 
Yes, I need to copy only one worksheet. I have 85 workbooks each month
that arrive from different office locations. Each wkbk contains 10
worksheets. I need to copy worksheet(6) from each of the 85 workbooks
into a "Monthly Summary" workbook. Since Worksheet(6) has the same
name in each of the 85 individual office workbooks, I want to use the
office number ("000") that appears in cell C2 of the sheet being
copied as a naming convention in my "Monthly Summary" workbook.

I noticed after the sheets are copied, they retain their formulas with
specific references. What I only need are the cell values. How can I
copy the sheets with only values rather than the formulas?

Also, where would I place the the following code to extend "pop-up
box"/GetFileName functionality. The 85 workbooks are in folders named
for each month (i.e., path is "C:\Data\DataFiles\Sept\(my 85 *.xls
files)".

varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)
If IsArray(varr) Then
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(varr(i))
wkbk.Worksheets.Copy After:=ThisWorkbook. _
Worksheets(ThisWorkbook.Worksheets.Count)
wkbk.Close SaveChanges:=False
Next
End If
_____________________________________________________________________________
Here's what I have so far:

Option Explicit
Sub GetSheets()
Dim sPath As String, i As Long
Dim varr As Variant
Dim wkbk As Workbook
sPath = "C:\Data\DataFiles\test\"
varr = Array("Data1.xls", "Data2.xls", "Data3.xls")
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(sPath & varr(i))
With wkbk.Worksheets(6)
On Error Resume Next
.Name = .Range("c2").Value
If Err.Number <> 0 Then
MsgBox .Name & " Couldn't be renamed"
Err.Clear
End If
On Error GoTo 0
.Copy After:=ThisWorkbook. _
Worksheets(ThisWorkbook.Worksheets.Count)
End With
wkbk.Close SaveChanges:=False
Next
End Sub
_____________________________________________________________________________
I sincerely appreiciate your willingness to offer assistance. I have
re-read and editted my post several times before posting to try and
explain my objectives. Once again, thanks...you guys are outstanding.

Kind Regards,
Mike Taylor
 
You can convert a range to values by copy|paste special values or even just
..value = .value.

And since we're closing the file w/o saving it, I did the conversion before the
copy:

Option Explicit
Sub GetSheets()
Dim i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim myExistingPath As String
Dim myPathToRetrieve As String

myExistingPath = CurDir
myPathToRetrieve = "c:\data\datafiles"

ChDrive myPathToRetrieve
ChDir myPathToRetrieve

varr = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(varr) Then
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(varr(i))
With wkbk.Worksheets(6) 'see note below
On Error Resume Next
.Name = .Range("c2").Value
If Err.Number <> 0 Then
MsgBox .Name & " Couldn't be renamed"
Err.Clear
End If
.UsedRange.Value = .UsedRange.Value
.Copy After:=ThisWorkbook. _
Worksheets(ThisWorkbook.Worksheets.Count)
End With
wkbk.Close SaveChanges:=False
Next
End If

'reset it back
ChDrive myExistingPath
ChDir myExistingPath

End Sub

And if you really know the name of the worksheet to be copied, you might want:

with worksheets("realnamehere")
instead of
with worksheets(6)

Going by the position in the workbook always scared me. (But if the users
change names, then that's scary, too!)
 
Back
Top