Linking several workbooks to a master workbook

[Shazza-D]

Hi

I'm fairly new to VBA and I am struggling to get something to work.

I have a folder with 6 workbooks (single sheet) which I would like to combine and display in one master workbook. Is there an easy way to do this?

Is it possible to get the master to update when changes have been made to the other books?

I have found this code (thanks to SNB) this works to a point - Is it possible to append each sheet to the next available column rather than the next free row? Also is there a way to keep source formatting?

Thanks in advance


Sub consolidate()
Dim sh As Worksheet, lr As Long, fPath As String, wb As Workbook, sh2 As Worksheet, fNm As String
Dim lstRw As Long, rng As Range
Set sh = Sheets(2)
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
fPath = "folder with the mutiple workbooks in it"
If Right(fPath, 1) <> "\" Then
fPath = fPath & "\"
End If
fNm = Dir(fPath & "*.xl*")
Do
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set wb = Workbooks.Open(fPath & fNm)
Set sh2 = wb.Sheets(1)
lstRw = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
Set rng = sh2.Range("A2:S2")
rng.EntireRow.Copy sh.Range("A" & lr + 1)
wb.Close False
fNm = Dir
Loop While fNm <> ""
End Sub
Sub Button1_Click()
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Filters.Add "Excelsior", "*.xl*"
.Show
For j = 1 To .SelectedItems.Count
With GetObject(.SelectedItems(j))
With .Sheets(1).UsedRange.Offset(1).Resize(, 19)
Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count) = .Value
End With
.Close 0
End With
Next
End With
End Sub

[Yongle]

Your questions:
1 I have a folder with 6 workbooks (single sheet) which I would like to combine and display in one master workbook. Is there an easy way to do this? YES
2 Is it possible to get the master to update when changes have been made to the other books? YES
3 Is it possible to append each sheet to the next available column rather than the next free row? Also is there a way to keep source formatting? YES

This post is similar to one with title "Need VBA" posted on 03/03/15 by sppraysoft and so my questions are very similar.

So, to be consistent, here are my questions:
1 Does every sheet look the same? What exactly are you trying to combine - numbers? text?
2 What does combine mean - are you wanting to add cells in same position in each sheet or build a table of values, taking information from many workbooks? (your question 3, suggests you probably want to copy each sheet into new columns )
3 Do the workbooks have special names, so that it is easy to group them together or are there only those 6 workbooks in the folder?

If you post a reply attaching 3 of the workbooks that you are trying to combine (as examples) perhaps we can help you.

[Shazza-D]

1296312964

Hi

Thanks for taking the time to reply.

I have attached an example of the master file and several of the sample files.

I am basically trying to create a departmental schedule - each department will have its own book which will then feed into the master schedule workbook. I would like to build a table, taking information from each workbook copying each sheet into new columns.

Each sheet has the same first 2 columns with the date and time - the cells contain a mixture of numbers and text and it is important to keep the source formatting as the staff use colour coding.

The top 2 rows contain names and job titles - however these will vary from sheet to sheet.

There will only be the six workbooks in the folder - each with a departmental name.

I hope that all makes sense - this is still all fairly new to me so I am trying to learn as I go along.

[Yongle]

Have looked at your sheets, thank you.
Attached is a new Master file (first 51 rows only)
Please check this
Is it how you want the Master file to look?
thanks

[Shazza-D]

This is perfect thankyou

I only need down to row 747 (the first sample file seems to have extra copies of the schedule in - sorry)

[Yongle]

OH - that makes a big difference. Much easier! Good!
I was about to send you a very different reply.
Can you confirm that all 6 files only have 747 rows.
thank you

[Shazza-D]

Yes each file has just 747 lines (my fault copying files late at night!)

[Yongle]

See if you are happy with what this does and then we need to chat about how we make it robust against future changes etc

I have attached a copy of my test worksheet, may be best if you try that first, but the code is posted below, if you prefer to go it alone! If you do, make sure that the your MasterFile has the first 2 columns in it - this combines the data only.

Instructions - put your 6 Schedule files in a folder of their own (no other Excel files in there otherwise they will be combined too)
Put the MasterTest file in a different folder.
BEFORE RUNNING - Change the FolderPath to match where you put 6 Schedule files.

Hope it is ok for you - any questions - ask
Yon



Sub Combine_Workbooks()

'Clear out old values in Master file (from Column C onwards)
Dim LastCol As Integer
Range("ZZ1").End(xlToLeft).Select
LastCol = ActiveCell.Column
Range(Columns(3), Columns(LastCol)).EntireColumn.Delete

' Modify this folder path to point to the files you want to use.
FolderPath = "D:\Documents\VBAForum\LinkingWorkbooks\Schedules\"

' NCol keeps track of where to insert new Column in the destination workbook.
Dim Ncol As Integer
Ncol = 3 ' starts at 3 to so that pasting happens from column C

' Call Dir the first time, pointing it to all Excel files in the folder path.
Filename = Dir(FolderPath & "*.xl*")

' Loop until Dir returns an empty string.
Do While Filename <> ""


' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & Filename)

' set the range to copy
Range("ZZ1").End(xlToLeft).Select
LastCol = ActiveCell.Column
Range(Cells(1, 3), Cells(747, LastCol)).Select
Selection.Copy

' this is where we paste based on where to put next column
Windows("MasterTest.xlsm").Activate
Cells.Item(1, Ncol).Select
ActiveSheet.Paste
Application.CutCopyMode = False

' set column widths for data columns, and set next column for posting
Range(Columns(), Columns(Ncol)).ColumnWidth = 25
Ncol = ActiveSheet.UsedRange.Columns.Count + 1

' close the source worksheet without saving
WorkBk.Close savechanges:=False

' Use Dir to get the next file name.
Filename = Dir()

Loop 'end of Filename loop

Range("A1").Select
End Sub

[Yongle]

After you have checked the code in previous post we can deal with your "update" question (Is it possible to get the Master to update when changes have been made to the other books?)

Master and Schedules are updated at different times and different users
Need to minimise risk of file permission issues

Suggested solution (there are several other ways of achieving this)
When Schedule file is closed by user, a macro saves a copy of Schedule to folder that Master uses to combine files

What you need to do
The code below needs inserting into each Schedule file - make sure you change the SaveAs filename
Use a different filename (Shedule 1 becomes Sch 1 etc) to avoid any confusion later

There is a special type of macro that will run when a file closes. And the easiest way to get at it is:
In VBA in left window under Microsoft Excel Projects, select This Workbook, and then at top left of code window select Worksheet, top right select BeforeClose

To finish the job put a macro into Master to run the "Combine" macro automatically when Master opens
Same method as above but in top right of code window select "Open" instead of BeforeClose

Yon
12969


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "D:\Documents\CopiesOfSchedules\Sch1.xlsm"
Application.DisplayAlerts = True
ActiveWorkbook.Close
End Sub

[Shazza-D]

Thankyou so much this looks fantastic - I'll have a play with it today

[snb]

@Yongle

Avoid 'Select' & 'Activate' in VBA.

[Yongle]

Blank Cells, Columns and Rows
Your worksheets contain several blanks, including blank rows. Blank cells, rows and columns cause problems in determining the starting cell for selecting ranges. I get the impression that your users delete headers etc if they have nothing to put in that column, and then leave the column blank. If you are happy to allow the user to do this, then your macros have to allow for it as well. Personally, I prefer to avoid blank columns/rows within any table of data. They cause problems with sorting, filtering etc (anything in fact that involves selecting ranges)

Specifically in the code
Range("ZZ1").End(xlToLeft).Select - this assumes that there is something in row 1 of the last active column to determine where the last column is.
If a user deletes the header in row 1, but enters something further down the column, debris will be left behind by Range(Columns(3), Columns(LastCol)).EntireColumn.Delete

The same problem would occur in the lines under set the range to copy
I would force an entry into the header whenever there is an entry in the column below and do that early on in the macro. Lots of options. One suggestion (which would need inserting in the code immediately below set the range to copy) is:

For i = 3 To 25 '3 is the first relevant column, 25 allows users to add several more columns
If Cells(1, i) = "" Then
If Application.CountA(Cells(1, i).EntireRow) > 0 Then
Cells(1, i).Value = "Forced Header"
Else
End If
Else
'do nothing
End If
Next i


Number of rows
At the moment the code is rigid and is fixed at 747 rows by line Range(Cells(1, 3), Cells(747, LastCol)).Select
To allow for extra rows (and next year is a leap year) you could change it to say 1000 (plenty big enough and would do no harm) or perhaps be very precise and replace the 747 with the variable LastRow and include this code immediately preceding that line

Dim lastrow As Long
Range("a1000").End(xlUp).Select
lastrow = ActiveCell.Row

[jpanucci]

I am not experienced with code at all, I am pretty good with excel. So here is my need, I have over 742 work sheet in 30 different workbooks, each has a different name and the data fields vary, total lines are no more than 400 per worksheet, I need to combine them all into one workbook with their original sheet name, on separate tabs. I then need to stack them all but this site has assisted me with a nice little VBA once I strip off the header information, but I would love to have something that would delete selected rows across all worksheet so I don't have to select all tab and then delete them.