Adjust VBA-Excel split code to combine similar tab names

I am using the below formula to split each excel tab into it's own workbook. The issue is I utilize Month, YTD and Full Year tabs for distribution; in my case they are broken out by name, so for example it would read "John Smith", "John Smith (2)" and "John Smith (3)" less the quotations. What I would like to do is combine each person's name onto one spreadsheet with all three tabs. I've heard that it can be done by using the first X letters, but more ideally I would like to breakout by exact matching name while excluding numbers and special characters, or if it's easier just cutting off the space and numbers after the name " (2)" and " (3)" as they are the only differences I will have (Excel will not allow for duplicate tab titles so this would have to process through VBA).

Code:

---

Sub Splitbook()
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
    xWs.Copy
    Application.ActiveWorkbook.SaveAs Filename:=xPath & "" & xWs.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

---

Hello CharlieP,

I revised your macro. It will scan the worksheets for unique names and associate the like named worksheets with the names. A workbook will be created for each unique name and the associated worksheets will be copied into it.

Code:

---

Sub SplitBook1()


    Dim Dict        As Object
    Dim Key        As Variant
    Dim n          As Long
    Dim Wkb        As Workbook
    Dim Wks        As Worksheet
    Dim WksObjs()  As Variant
       
        Set Dict = CreateObject("Scripting.Dictionary")
            Dict.CompareMode = vbTextCompare
           
            '// Associate worksheets with names.
            For Each Wks In ThisWorkbook.Worksheets
                n = InStrRev(Wks.Name, " ")
               
                If n > 1 Then
                    Key = Left(Wks.Name, n - 1)
                Else
                    Key = Wks.Name
                End If
               
                If Not Dict.Exists(Key) Then
                    ReDim WksObjs(0)
                        Set WksObjs(0) = Wks
                    Dict.Add Key, WksObjs
                Else
                    WksObjs = Dict(Key)
                        n = UBound(WksObjs) + 1
                        ReDim Preserve WksObjs(n)
                        Set WksObjs(n) = Wks
                    Dict(Key) = WksObjs
                End If
            Next Wks
               
        '// Create workbooks from names and load with associated worksheets.
        For Each Key In Dict.Keys
            WksObjs = Dict(Key)
            WksObjs(0).Copy
            Set Wkb = ActiveWorkbook
                For n = 1 To UBound(WksObjs)
                    Set Wks = WksObjs(n)
                    Wks.Copy After:=Wkb.Worksheets(Wkb.Worksheets.Count)
                Next n
            Wkb.SaveAs ThisWorkbook.Path & Key & ".xlsx"
        Next Key
       
End Sub

---

Hi Leath,

I appreciate the response. I tried it out but ran into a couple of issues listed below.

Created two files for each name, first containing pivot table 1 of 3 and second containing pivot tables 2 and 3 of 3 (giving hope as it successfully merged the latter two).

Automatically opening files once saved, wouldn't normally be an issue but as it's usually 40+ files at once it causes issues.

Saving files in folder one level up from current file, but first portion of title uses base folder name (i.e. original file in test folder, new files are saved one level up as TestJohn and TestJohn Smith). - Not a huge issue as I can just create another sub-folder to use and I change the titles anyway.

Thanks for your help,

Charlie

Hello Charlie,

From your first post it appears that you save the new workbook in the same folder as the main workbook. My version of the macro does this. Yet you mention folder levels. Where did you mention that? What does this hierarchy look like?

Good Morning Leath,

Yes, for some reason it was placing the name of the folder containing the file used into the name of each new file and saving the files one level up. I put a few test names in and had the below results. The original file is titled "ABC" within the Test2 folder, as you can see the files have saved in the "Test" folder one level up from "Test2" but utilized the text "Test2" before each of the tab names pulled.

Next comes the two files, the files with only a first name contain Pivot Table 1 of 3; the files with full names contain pivot tables 2 and 3 of 3. So it partially worked with consolidating, but ideally would combine all three Pivot Tables onto one file.

Attachment 23544.

Thanks again for your help!

Charlie

Quote:

---

Originally Posted by Leith Ross

Hello Charlie,

From your first post it appears that you save the new workbook in the same folder as the main workbook. My version of the macro does this. Yet you mention folder levels. Where did you mention that? What does this hierarchy look like?

---