Splitting excel sheets (Not copy paste data range) into separate workbooks with a certain name

[Bill_k]

I have a workbook with multiple sheets that have a name in column AA3 which might match in 2 or more sheets. The macro needs to search these cells and club all sheets with a similar name in AA3 and then make a new workbook out of them using the same name.

Please advise a solution.

 

[Fluff]

Hia
Is this what your after

Sub ExportShts()

    Dim Pth As String
    Dim Arr As Variant
    Dim Sht As Worksheet
    Dim ShtDict As Object
    Dim Rng As Range
    Dim Ky As Variant

Application.ScreenUpdating = False

    Pth = ThisWorkbook.Path
    Set ShtDict = CreateObject("scripting.dictionary")
    
    For Each Sht In Worksheets
        Set Rng = Sht.Range("AA3")
        With ShtDict
            If Not .Exists(Rng.Text) Then
                .Add Rng.Text, Sht.Name
            Else:
                .Item(Rng.Text) = .Item(Rng.Text) & "|" & Sht.Name
            End If
        End With
    Next Sht
    
    For Each Ky In ShtDict.Keys
        If InStr(ShtDict(Ky), "|") > 0 Then
        Arr = Split(ShtDict(Ky), "|")
        Sheets(Arr).Copy
        ActiveWorkbook.Close savechanges:=True, Filename:=Pth & "\" & Ky & ".[COLOR=#0000ff]xlsx[/COLOR]"
        End If
    Next Ky
    
Application.ScreenUpdating = True

End Sub

Change the file extension to suit

 

[Bill_k]

Wow... you're such a genius. This is sooo awesome!

 

[Bill_k]

Funny enough... it worked the first time but then gave this error:

ActiveWorkbook.Close savechanges:=True, Filename:=Pth & "" & Ky & ".xlsx"

 

[Fluff]

What error message did it give?
If the files already exist it should have asked if you want to replace it.

 

[Bill_k]

I'm sorry that was because of a tweak I did to the name. Got it back to where it was. Working flawlessly now. Thank you very much.

 

[Fluff]

Glad to help & thanks for the feedback