Combining selective worksheets to a separate workbook

[nirmala.seetharaman]

I have a workbook that contains multiple worksheets. One of the sheets "SheetList" lists all the worksheet names (example below). I need to now group the worksheets based on the codes in their names and save them as a separate workbook. Is this possible using a macro ?
Example - SheetList worksheet contains below data -
A-01
A-02
A-03
B-01
B-02
C-01
Now I need to have 3 different workbooks with each of them containing their respective worksheets ie., Workbook1 contains worksheets A-01, A-02, A-03 ; Workbook2 contains worksheets B-01, B-02 and Workbook3 contains C-01
Appreciate your help and advice on how this can be achieved.
Thanks in advance. <!---->
<!---->

 

[Krishnakumar]

Hi Nirmala,

Try this

Sub kTest()
    Dim wbkActive   As Workbook
    Dim wbkNew      As Workbook
    Dim SheetList, i As Long
    Dim ShtGroup  As String, k, ka
    
    Set wbkActive = ThisWorkbook
    
    SheetList = wbkActive.Worksheets("SheetList").Range("a2:a6") '<<==== adjust the range
    
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For i = 1 To UBound(SheetList, 1)
            ShtGroup = Split(SheetList(i, 1), "-")(0)
            .Item(ShtGroup) = .Item(ShtGroup) & IIf(.Item(ShtGroup) = "", "", ",") & SheetList(i, 1)
        Next
        ka = .Items: k = .keys
    End With
    
    For i = LBound(ka) To UBound(ka)
        Application.Goto wbkActive.Worksheets("SheetList").Range("a1")
        wbkActive.Worksheets(Split(ka(i), ",")).Select
        wbkActive.Worksheets(Split(ka(i), ",")).Copy
        Set wbkNew = ActiveWorkbook
        wbkNew.SaveAs wbkActive.Path & "\Group-" & k(i)
        wbkNew.Close
        Set wbkNew = Nothing
    Next
        
End Sub

HTH

 

[nirmala.seetharaman]

Thanks a lot Krishna. The code worked liked a charm Just what I had wanted.