import multiple workbooks into 1 workbook

[Anita]

I'm setting up a webshop and using Excel to put in the products.
I've got seperate workbooks for my 20 product-groups (20 excel
documents),
and each group is devided in brands (a min. of 5 brands per product
group),
which are in worksheets. I've got 20 seperate workbooks (eg
group1.xls; group2.xls; group3.xls etc.)
Each of those workbook is devided into brands bij using worksheets.

I would like to make a file that imports all the data from all the
worksheets, without me having to save each worksheet into a different
text file (over 100!).
I've tried to copy the data and past it as a link, but when a row is
added in the original document,
updating the link doesn't add the added row.
I've tried to import from text files, it does add added rows, but I've
got
to save all my worksheets as text files (over 100).

I placed this in a wrong newsgroup for windows users but i got the
following Marco from someone:

Public Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Sub MergeSheets()
Dim sh As Worksheet
Dim last As Long
Dim rng As Range
Dim shLast As Long
Worksheets("Master").Cells.ClearContents
Worksheets("Master").Range("a1").Value = "All sheets"
For Each sh In ThisWorkbook.Worksheets
If UCase(sh.Name) <> "MASTER" Then
last = LastRow(Worksheets("Master"))
shLast = LastRow(sh)
Set rng = Worksheets("Master").Cells(last + 1, 1)
sh.Range(sh.Rows(1), sh.Rows(shLast)).Copy Destination:=rng
End If
Next
End Sub

But it shows a runtime error, and Excel want to debug this line:
sh.Range(sh.Rows(1), sh.Rows(shLast)).Copy Destination:=rng

Can anyone help me out here?

 

[Bernard Rey]

But it shows a runtime error, and Excel want to debug this line:

sh.Range(sh.Rows(1), sh.Rows(shLast)).Copy Destination:=rng

Does it run - and then stop after some turns - or doesn't it run at all?
I've tested it with Excel 2004, X, 2001 and (last but not least) '98: it
worked as expected... Could there be something specific in your original
sheets? Could there be too many rows (thus reaching the 65536 limit)?

 

[Anita]

It only adds "All Sheets" to A1. Than it wants to debug.
I have about 24 products devided into 4 worksheets, all sheets contain
a different number of products.
There are formulas in some columns.
There was a list manager on the sheets, but removing them didn't help.
In all sheets I have the same number of columns and the same first
rows.
The Master sheet is the last sheet, but making it the first sheet
didn't help either.

This Macro is only ment to merge sheets in one document. That would
make me very happy, but I would be even more happy if I could
automaticly combine all the worksheets of different documents.

I hope this info was helpfull.

 

[Bernard Rey]

It only adds "All Sheets" to A1. Than it wants to debug.

OK, there must be something in the worksheet, then.

I have about 24 products devided into 4 worksheets, all sheets contain
a different number of products.
There are formulas in some columns.
There was a list manager on the sheets, but removing them didn't help.
In all sheets I have the same number of columns and the same first
rows.
The Master sheet is the last sheet, but making it the first sheet
didn't help either.

Do you think you could send a workbook over to me? I'd rather have a look at
it to find out what is preventing the macro to run. There *must* be
something!

This Macro is only ment to merge sheets in one document. That would
make me very happy, but I would be even more happy if I could
automaticly combine all the worksheets of different documents.

I'll see how to try and adapt it. But that's not the difficult part about
it.

 

[Bernard Rey]

Anita :

It only adds "All Sheets" to A1. Than it wants to debug.

I think I figured it out: I suppose you haven't copied the macro in a VBA
module added to your original workbook, but to another workbook. So, when it
comes to the
For Each sh In ThisWorkbook.Worksheets
line, "ThisWorkbook" won't refer to your active Workbook (as you'd expect, I
suppose), but to the one to which the macro module belongs to.

If you insert a VBA module in your workbook and copy the macro on it, it
does work, as I could find out with the workbook you sent to me.

I have about 24 products devided into 4 worksheets, all sheets contain
a different number of products.
There are formulas in some columns.
There was a list manager on the sheets, but removing them didn't help.

This Macro is only ment to merge sheets in one document. That would
make me very happy, but I would be even more happy if I could
automaticly combine all the worksheets of different documents.

So, here's a new version, and it should merge all your 24 workbooks into
one, each sheet bearing the content of every sheet in one workbook. I still
have to test it to see if this does work well on the Mac (I'm working on a
Windows version here!). There's no need to add any "Master" sheet to your
workbooks any more. But there needs to be a "Master.xls" Workbook, containing
a "Template" Worksheet with the column headers I guess you'd like to keep.
I'll send you a copy of such a workbook later tonight, after having tested it
on the Mac. The macro will already be inside, of course.

Basically, you'll have to gather your 24 wokbooks into one Folder, in which
you'll have to put that "Master.xls" workbook too. When prompted to, you'll
browse to that "Master.xls" book, (in order to get the filepath to the
folder). And that should be all...


So here's the new set:

Public Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), Lookat:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Sub MergeBooks()
Dim sh As Worksheet
Dim last As Long, shLast As Long
Dim rng As Range
Dim MyPath As String, MyDir As String
MyPath = Application.GetOpenFilename _
(Title:="Where is your ""Master.xls"" file?", _
ButtonText:="Choose")
MyPath = Left(MyPath, Len(MyPath) - 10)
MyDir = Left(MyPath, Len(MyPath) - 1)
Dim F
With Application.FileSearch
..NewSearch
..LookIn = MyDir
..Execute
On Error Resume Next
For Each F In .FoundFiles
If F = MyPath & "Master.xls" Then GoTo TheNextBook
Mytab = Right(F, Len(F) - Len(MyPath))
If Right(Mytab, 4) = ".xls" Then Mytab = Left(Mytab, Len(Mytab) - 4)
Workbooks("Master").Activate
Sheets("Template").Copy before:=Worksheets("Template")
ActiveSheet.Name = Mytab
Workbooks.Open F
For Each sh In ActiveWorkbook.Worksheets
last = LastRow(Workbooks("Master.xls").Worksheets(Mytab))
shLast = LastRow(sh)
Set rng = Workbooks("Master.xls").Worksheets(Mytab).Cells(last + 1, 1)
sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy Destination:=rng
Next sh
ActiveWorkbook.Close
TheNextBook:
Next F
End With
Worksheets("Template").Delete
End Sub

 

[Bernard Rey]

There was no way to get a Application.FileFind running in Excel 2004, of
course, so I couldn't adapt the macro to the Mac!

But, in the meantime, Anita had managed to merge the sheets in the workbooks
with the original macro. And she then had come across another Windows macro,
in order to merge the resulting "Master" sheets into one Workbook. So, for
the record, here is the adapted macro that should do the job:

Sub TestFile6()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "Macintosh HD:Users:Youesktoproducts" 'to be adapted
ChDrive MyPath
ChDir MyPath
FNames = Dir("", 0)
If Len(FNames) = 0 Then
MsgBox "No files in that Folder"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
mybook.Worksheets("Master").Copy after:= _
basebook.Sheets(basebook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0
' You can use this if you want to copy only the values
' With ActiveSheet.UsedRange
' .Value = .Value
' End With
mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub