Combining Multiple Workbooks and creating separate workbooks with multiple tabs

[ksbcis]

Hi All,

I must say, I've received so much help throughout the years on this forum, that I am greatful.

I have a new question that I'm hoping someone can help me with. I have to combine multiple workbooks, each have one spreadsheet and all in one directory, where I'm taking workbooks with a similar naming scheme and placing them in a new workbook. For example:

If I had workbook-1, workbook-2, and workbook-3, I would like to take these workbooks and combine into a new workbook titled lets say "Workbook" with workbook-1, workbook-2, and workbook-3 each having their own tab/spreadsheet in the new workbook "Workbook".

Also, if I had the following workbooks: sp-1, sp-2, and sp-3, I would like to combine these into a new workbook titled "SP" each having its own spreadsheet in the new workbook "SP". Each spreadsheet in "SP" should be titled SP-1, SP-2, and SP-3 respectively.

The problem is that there are a few hundred of these and I'm not sure how to attack this merge. Any thoughts? I have the code for a basic merge into one workbook (From a previous VBAX posting), but I don't know how to create separate workbooks based on the naming scheme. Any help would be greatly appreciated.

Here's what I have for a basic single workbook merge.

[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 = "C:\" '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]

[GTO]

Attach a wb with the names of ALL the files in the sub-directory. Maybe we can see a decent pattern

[ksbcis]

Attach a wb with the names of ALL the files in the sub-directory. Maybe we can see a decent pattern

Hi GTO! It's hard to insert the names of all the workbooks as it's too numerous. Here is the pattern below:

2HERALD-ROLL-LEDIT-1.xls
2HERALD-ROLL-BOOK-1.xls
2HERALD-ROLL-CFP-1.xls
2HERALD-ROLL-CFP-2.xls
2HERALD-ROLL-CFP-3.xls
2HERALD-ROLL-LASS-1.xls
2HERALD-ROLL-OCC-1.xls
2HERALD-ROLL-RENTROLL-1.xls
2HERALD-ROLL-TASS-1.xls

3COLUMBUS-ROLL-LEDIT-1.xls
3COLUMBUS-ROLL-BOOK-1.xls
3COLUMBUS-ROLL-CFP-1.xls
3COLUMBUS-ROLL-CFP-2.xls
3COLUMBUS-ROLL-CFP-3.xls
3COLUMBUS-ROLL-LASS-1.xls
3COLUMBUS-ROLL-OCC-1.xls
3COLUMBUS-ROLL-RENTROLL-1.xls
3COLUMBUS-ROLL-TASS-1.xls

As you can see, the naming scheme above is precisely the same with the exception of the initial name (Example, 2HERALD and 3COLUMBUS). The pattern repeats itself for each name. So there is 9 different versions of 2HERALD and 9 different versions of 3COLUMBUS. This pattern will repeat itself 9 times for every new name. There is only 1 sheet in each workbook.

I hope this helps!

Thanks again!

ksbcis

[GTO]

That may indeed help if what I am surmising is accurate.

So to clarify, we can count on what's before the first hyphen, as identifying the workbooks that we would like to group, is that a "for sure" correct?

[ksbcis]

That may indeed help if what I am surmising is accurate.

So to clarify, we can count on what's before the first hyphen, as identifying the workbooks that we would like to group, is that a "for sure" correct?

That is absolutely right! You can definitely count on whatever is before the first hyphen as the identifying factor for the workbooks that I would like to group.

[GTO]

In a Standard Module:

[VBA]Option Explicit

Sub MergeDataByWBGroup()
Dim FSO As Object ' FileSystemObject
Dim fsoFol As Object ' Folder
Dim fsoFil As Object ' File
Dim DIC As Object ' Dictionary
Dim WB As Workbook
Dim WBNew As Workbook
Dim wks As Worksheet

Dim Keys() As Variant
Dim Path As String
Dim PathNew As String
Dim i As Long

Path = ThisWorkbook.Path & "\"

'// Set references to new Dictionary and FileSystemObject Objects, as well as to the//
'// folder ThisWorkbook resides in. //
Set DIC = CreateObject("Scripting.Dictionary")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set fsoFol = FSO.GetFolder(ThisWorkbook.Path & "\")

For Each fsoFil In fsoFol.Files
'// For ea file in the folder, test to see it meets our criterias of: filename //
'// ends in .xls, .xlsm, .xlsx,..., AND there's a hyphen in the filename, AND //
'// its not ThisWorkbook. //
If Mid(fsoFil.Name, InStrRev(fsoFil.Name, ".") + 1) Like "xls*" _
And InStr(1, fsoFil.Name, "-") > 0 _
And Not fsoFil.Name = ThisWorkbook.Name Then
'// IF we passed those tests, assign what's left of the first hyphen //
'// (trimmed) to a unique key. When we run into other filenames similar, //
'// .Item just gets overwritten, so no need to check .Exists. //
DIC.Item(Trim(Left(fsoFil.Name, InStr(1, fsoFil.Name, "-") - 1))) = Empty
End If
Next

'// Then assign our unique keys to an array. //
Keys = DIC.Keys

'// Optional, I create a folder to hold the new wb's in. //
If Not FSO.FolderExists(Path & "Temp") Then
FSO.CreateFolder Path & "Temp"
End If
PathNew = Path & "Temp\"

'// For ea element in our array... //
For i = LBound(Keys) To UBound(Keys)
'// ...create a new wb to plunk the sheets in. //
Set WBNew = Workbooks.Add(xlWBATWorksheet)
'// Then loop thru the files in the folder to see... //
For Each fsoFil In fsoFol.Files
'// ...if the file matches what we're looking for to group by. //
If fsoFil.Name Like Keys(i) & "*" Then
'// If TRUE, set a reference to the file while opening it,... //
Set WB = Workbooks.Open(fsoFil.Path, False)
'// ...copy the one sheet to the end of our created wb,... //
WB.Worksheets(1).Copy After:=NewWB.Worksheets(WBNew.Worksheets.Count)

'// ...rename the copied worksheet and then,... //
WBNew.Worksheets(WBNew.Worksheets.Count).Name = _
Left(Left(fsoFil.Name, InStrRev(fsoFil.Name, ".") - 1), 31)

'(NOTE: I figure the above is where trouble may arise. If there are)
'( many files and some have longer names, we may have to handle)
'( the possibility of the first 31 chars being the same. )

'// ...close the found wb w/o saving any changes. //
WB.Close False
End If
Next

'// Back to our outer loop, we have now added a sheet for ea file that matched //
'// and we can delete the one blank sheet that the created wb started with. //
Application.DisplayAlerts = False
WBNew.Worksheets(1).Delete
Application.DisplayAlerts = True

'// SaveAs and close the created wb. //
WBNew.SaveAs PathNew & Keys(i) & ".xls"
WBNew.Close False
Next
End Sub[/VBA]

Notes:

• ThisWorkbook needs to reside in the same folder as the workbooks we are running through.
• Thus far at least, I have no real 'safetys' built-in. As mentioned in the comments, I could see an error occurring if there are any workbooks with longer names, wherein the first 31 cahracters are the same.
• I also did not tack in deleting any prior created wb's, so after you run once, you must delete the temp folder or at least the created wb's therein.

In case you do run into problems with naming the copied sheets, here is an easy bit of code to create a list of filenames in the folder.

[VBA]Sub listfilesinfolder()
Dim FSO As Object ' FileSystemObject
Dim fsoFol As Object ' Folder
Dim fsoFil As Object ' File
Dim wks As Worksheet
Dim i As Long
Dim Path As String
Path = ThisWorkbook.Path & "\"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set fsoFol = FSO.GetFolder(ThisWorkbook.Path & "\")
With ThisWorkbook
Set wks = .Worksheets.Add(, .Worksheets(.Worksheets.Count), , xlWorksheet)
End With
For Each fsoFil In fsoFol.Files
i = i + 1
wks.Cells(i + 1, 1).Value = fsoFil.Name
Next
End Sub[/VBA]

Hope that helps,

Mark

[ksbcis]

Hey Mark!

Thanks for the quick response with that code. I temporarily lost internet in my neighborhood so I was unable to login for a while. Just recently got internet access back up and running.

I tried running your code and I got a copile error.

"Compile error:
Variable not defined"

Then the compile error references the line below with the "NewWB" field highlighted as shown below. I created a workbook in the folder where the rest of the files reside. Any thoughts? Did I miss a step?

WB.Worksheets(1).Copy After:=NewWB.Worksheets(WBNew.Worksheets.Count)

Thanks,

ksbcis

[ksbcis]

Hey Mark,

I figured it out. It turns out that the variable you set is 'WBNew' and not 'NewWB'. Upon changing NewWB to WBNew, it works!

I mean this in a respectful way. You are the F****** man! It helped me out alot! Thanks for making my weekend dude!

Regards,

ksbcis

[GTO]

WB.Worksheets(1).Copy After:=NewWB.Worksheets(WBNew.Worksheets.Count)

Sorry about that. I did a Replace All/whole word only and it missed due to being against the equal sign.

I'm glad you spotted it and got 'er running

[ksbcis]

Many thanks once again!

[ksbcis]

I have one more question for you. Using the same information below

2HERALD-ROLL-LEDIT-1.xls
2HERALD-ROLL-BOOK-1.xls
2HERALD-ROLL-CFP-1.xls
2HERALD-ROLL-CFP-2.xls
2HERALD-ROLL-CFP-3.xls
2HERALD-ROLL-LASS-1.xls
2HERALD-ROLL-OCC-1.xls
2HERALD-ROLL-RENTROLL-1.xls
2HERALD-ROLL-TASS-1.xls

Can I modify the code slightly to create new workbooks based on the revision name? For example, if you take "2HERALD-ROLL-LEDIT-1.xls" can I create a new workbook titled "LEDIT-1" and have every workbook with "LEDIT-1" in the naming scheme dumped into this new workbook, "LEDIT-1" ? It seems like it would be a slight modification of the code above you provided.

Thanks,

ksbcis