Solved: Combine multiple workbooks from various locations into one master workbook

I'm trying to modified this code below but no luck. What I'm trying to do is to combinde multiple workbook into one master workbook. These files are from multiple file paths its suppose to open the last modified file in those folders and grab all the worksheets in those workbooks and insert all the worksheets into the master workbook. So the master workbook could have about 9 worksheets in total.

Does anyone has any ideas how to go about this?

I aslo found this code. Its by DRJ it almost does everything what I'm after. But can it be modified to open the last modified files from those various locations?

http://www.vbaexpress.com/kb/getarticle.php?kb_id=221



[VBA] Sub Combine_MultipleFiles()
Dim Wkb As Workbook
Dim i As Integer
Application.EnableEvents = False
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = "Z:\Performance\Daily Data\Sample\"
.LookIn = "Z:\Performance\Daily Charts\Test\"
.LookIn = "Z:\Maker\"
.LastModified = msoLastModifiedToday
.SearchSubFolders = IncludeSubFolders
.FileType = msoFileTypeExcelWorkbooks
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
ReDim strFilelist(.FoundFiles.Count)
For i = 1 To .FoundFiles.Count
Set Wkb = Workbooks.Open(.FoundFiles(i))
WS.Copy after:=OWB.Worksheets(OWB.Worksheets.Count)
Wkb.Close SaveChanges:=False
Next i
End If
End With
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
[/VBA]

It may be easier just to cycle through the OPEN workbooks, as you can have all of them open at once to do this.......would something like that work...? The below will copy sheet in 1st position from all open workbooks into the destination workbook.

[VBA]
Dim Wkb1 As Workbook, Wkb2 As Workbook, wb As Workbook
Set Wkb1 = Workbooks("Destination.xls")

'loop through the open files
'
counter = 1 'set counter at 1
For Each wb In Workbooks
If wb.Name <> "PERSONAL.XLS" And wb.Name <> Wkb1.Name Then
wb.Activate

wb.Sheets(1).Copy Wkb1.Sheets.Add

counter = counter + 1
Application.DisplayAlerts = False
wb.Close
End If
Next wb

Wkb1.Activate
MsgBox counter & " Files were copied into Destination"

End Sub
[/VBA]

Just change the name of your destination file, activate the destination file and sheet 1 will copy into that workbook...

for multiple sheets
[VBA]
For each w in wb.Worksheets
w.Copy Wkb1.Sheets.Add
Next w
[/VBA]

Hey Gibbs thanks for replying. Well The code you see below is exactly what I'm looking for its by DJR. But I cant figured out how to adjust it to open the last modified file in thoses folders.

I tried to stick this line code in DJR code but it does not work. Am I missing something?

[VBA].LastModified = msoLastModifiedAnyTime[/VBA]




[VBA]
Option Explicit

Sub CombineFiles()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "Z:\Performance\Daily Data\Sample\" 'Change as needed
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False
FileName = Dir()
Loop

Path = "Z:\Performance\Daily Charts\Test\" 'Change as needed
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False
FileName = Dir()
Loop

Path = "Z:\Maker\" 'Change as needed
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False
FileName = Dir()
Loop

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
[/VBA]

Finding the last modified date requires looping through each file in a pathname and evaluating each modified data to see if it is greater than the next.

If this is a recurring need, this can be done, if it is a one time thing, looping through open workibooks is far more simple..

amybe something like this will help? Untested...must set reference to Windows Script Host Object Model. In theory it will look for a modified date equal to today (in mm/dd/yy) format and if it finds one, it sets that as your workbook...not sure if it helps, but a modified approach from where you are at...


[VBA]

Dim objFSO As FileSystemObject, objFolder As folder
Dim objFile As file, strSourcePath As String

strSourcePath = "Z:\Performance\Daily Data\Sample" 'Change as needed

ModToday = False
Set objFSO = New FileSystemObject 'creates a new File System Object reference
Set objFolder = objFSO.GetFolder(strSourcePath)
For each objFile in objFolder
If ModToday = False Then
If Format(objFile.DateLastModified, "mm/dd/yy") = Format(Now(), "mm/dd/yy") Then
ModToday = True
myFiletoCopy = objFile.Name
Exit For
End If
End If
Next objFile

Set Wkb = Workbooks.Open(FileName:=strSourcePath & "\" & myFiletoCopy)
For Each Ws In Wkb.Worksheets
Ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next Ws
Wkb.Close False

[/VBA]

I have code for accessing file system objects at the below linkl, for copying files from a folder...

http://www.vbaexpress.com/kb/getarticle.php?kb_id=827

Hi Gibbs,



I'm getting this line a error in the code:


[VBA] For Each objFile In objFolder[/VBA]


I'll be running the code daily.

I did set Windows Script Host Object Model.

What do you think?

Hmmm,. that method of declaring and For...Each works here, and have used it many times.

You can try Dim objFile as FileSystemObject as opposed to "as File"

I am unsure what would cause that error as I can not duplicate it. Remember though, that code was more of a suggestion than a plug and play, and although correct for the most part with syntax it was untested.

However, I do use this method, with the WSHO model for many other projects....

I'm sorry Gibbs I just can't get your code to work. I believe DJR code is the one for me. All I need is a little modification to the code to pick the Last Modified File in that folder. Please any suggestions on the code below?



[VBA]
Option Explicit

Sub CombineFiles()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "Z:\Performance\Daily Data\Sample\" 'Change as needed
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
[/VBA]

I am not sure that can be simply modified as you wish. You must first identify the last modified date of each file to determine which one was last, and THEN open it correct?

It is not quite as simple as just tagging a condition for the last one modified...at least not for me. I am still perplexed as to why my code was not working for you as I use it frequently...are you sure you had the WSHO referenced?


I still think there may be an easier way...that trying to identify the last modified date for a group of files as a criteria....is this a recurring, daily issue that requires such an event?

Sinec the same file name cannot appear twice in a folder, regardless of last modified date...can it not be determined in advance waht the actual file name will be?

Hi Gibbs I did check marked the WSHO referenced but it gives me a error on this line For Each objFile In objFolder. The code below that I use opens up the last modified excel file in the folder. I tried to interegrate with DJR code but it does not work. Am i missing something?

[VBA] Sub Test()

With Application.FileSearch
.NewSearch
.LookIn = "Z:\Performance\Daily Data\Sample\"
.LastModified = msoLastModifiedAnyTime
.FileName = ""
If .Execute(msoSortByFileName, msoSortOrderDescending, True) > 0 Then
Workbooks.OpenText .FoundFiles(1), xlWindows

End If
End With

End Sub
[/VBA]

This is tested, and will open the last modified file in a given folder, using both codes you posted, modified to work correctly. It copies each sheet from the opened workbook into the file the code is run from (must have this code in the desired destination workbook....)

Hope that gets this down..sorry for the confusion about what it was you needed to do....

Let me know if you need it modified to do anything else.

[VBA]
Sub CombineFiles()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False

Path = "Z:\Performance\Daily Data\Sample" 'do not put the \ at the end

With Application.FileSearch
.NewSearch
.LookIn = Path
.LastModified = msoLastModifiedAnyTime
.FileName = ""
If .Execute(msoSortByFileName, msoSortOrderDescending, True) > 0 Then
Workbooks.Open .FoundFiles(1), xlWindows

End If
End With
Set Wkb = ActiveWorkbook
For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
[/VBA]

Thank You very much Gibbs it works perfect. One more thing these workbooks contains links how can we disable those links when openning those workbooks?

Sure: change the code to this, I put the toggling in a separate sub, a habit of mine to make it simpler to perform the same action in lots of routines...

[VBA]Sub CombineFiles()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

ToggleStuff False

Path = "Z:\Performance\Daily Data\Sample" 'do not put the \ at the end

With Application.FileSearch
.NewSearch
.LookIn = Path
.LastModified = msoLastModifiedAnyTime
.FileName = ""
If .Execute(msoSortByFileName, msoSortOrderDescending, True) > 0 Then
Workbooks.Open .FoundFiles(1), xlWindows

End If
End With
Set Wkb = ActiveWorkbook
For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False

ToggleStuff True
End Sub

Sub ToggleStuff(ByVal x As Boolean)

With Application
.EnableEvents = x
.ScreenUpdating = x
.DisplayAlerts = x
.AskToUpdateLinks = x
End With

End Sub
[/VBA]

Thank You so much Gibbs.

Quote:

---

Originally Posted by Shazam

Thank You so much Gibbs.

---

You are very welcome. Happy to have helped out....eventually http://vbaexpress.com/forum/images/smilies/beerchug.gif

Just be sure to change this to solved if the issue is resolved. Thanks!

Hi XLGibbs

I came into a problem The code you provided to me works fine but its not copying worksheet charts it only copying regular worksheets but not worksheet charts. Is there a way to modified that?

This should take care of that.

[vba]
Sub CombineFiles()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet
Dim Ch As Chart


ToggleStuff False

Path = "Z:\Performance\Daily Data\Sample" 'do not put the \ at the end

With Application.FileSearch
.NewSearch
.LookIn = Path
.LastModified = msoLastModifiedAnyTime
.FileName = ""
If .Execute(msoSortByFileName, msoSortOrderDescending, True) > 0 Then
Workbooks.Open .FoundFiles(1), xlWindows

End If
End With
Set Wkb = ActiveWorkbook
For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
For Each Ch In Wkb.Charts
Ch.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next Ch

Wkb.Close False

ToggleStuff True
End Sub

Sub ToggleStuff(ByVal x As Boolean)

With Application
.EnableEvents = x
.ScreenUpdating = x
.DisplayAlerts = x
.AskToUpdateLinks = x
End With

End Sub
[/vba]
Simply adding another loop to find and copy the chart sheets would do it. Although I thought they would get captured with Worksheets....hmmp.

Once again thank You very much XLGibbs. I have another question can this code could be modified to work in power point?

Code:

---


Option Explicit

Sub CombineFiles()
   
    Dim Path            As String
    Dim FileName        As String
    Dim Wkb            As Workbook
    Dim WS              As Worksheet
   
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Path = "S:\Conference\Presentaions" 'Change as needed
    FileName = Dir(Path & "\*.xls", vbNormal)
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
        For Each WS In Wkb.Worksheets
            WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Next WS
        Wkb.Close False
        FileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
 
End Sub

---

The reason is right now I'm showing all the worksheet tabs on a projector at the production meeting. Can I run a macro on Excel or power point that it will copy each worksheet and paste it in each individual slide in power point?

I am sure it can be done, but I have no experience in Powerpoint VBA as of yet. Sorry can't help you with this last bit ...:(

Thats ok thank you for the help. I will start a new thread for this manner in the power point forum.