Splitting Sheets with Same Name Range in One Excel Workbook - Excel VBA

Question

I have some Excel workbooks which contains more than 100 sheets. The sheet names like below;

TTBMA2453_Speclist, TTBMA2454_Speclist, TTBMA2455_Speclist and goes on..
WBXXTTBMA2453_Featurelist, WBXXTTBMA2454_Featurelist, WBXXTTBMA2455_Featurelist and goes on..
WBXXTTBMA2453_Corelist, WBXXTTBMA2454_Corelist, WBXXTTBMA2455_Corelist and goes on..

I want to split all spec, feature and corelist sheets which are starting with same speclist name in the same workbook and merge/save to another Excel workbook in a specific file using Excel VBA.

(e.g combining TTBMA2453_Speclist, WBXXTTBMA2453_Featurelist WBXXTTBMA2453_Corelist and copy them as new workbook with original sheets)

Please find the code sample I have. This code splits sheets of the same name (which I added manually) into workbooks. However, this code does not re-merge the sheets in a different workbook and sheet names are entered manually. So, that's not what I want.

Sub SplitEachWorksheet()
  Dim FPath As String
  FPath = Application.ActiveWorkbook.Path
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Dim ws As Worksheet
  Dim fnameList, fnameCurFile As Variant
  Dim countFiles, countSheets As Integer
  Dim wksCurSheet As Worksheet
  Dim wbkCurBook, wbkSrcBook As Workbook
  
  For Each ws In ThisWorkbook.Worksheets
    If Left$(ws.Name, 9) = "TTBMA2453" Then ' <--- added an IF statement
        ws.Copy
        
        Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
        Application.ActiveWorkbook.Close False
        
    End If
    
  Next
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  
End Sub

Can you clarify that if all these worksheets' name follow the exact format? `[SpecName]_Speclist`, `WBXX[SpecName]_Featurelist` and `WBXX[SpecName]_Corelist`? I.e. if I can identify the spec name, the featurelist and corelist's worksheet name can be built based on that knowledge? @Yusuf — Raymond Wu, Nov 20 '21 at 13:23
Correct, all these worksheets follows the exact format which you mentioned. P.s. Spec names differs like TTBMA2453, TTBMA2454 and TTBMA2455.... — Yusuf, Nov 20 '21 at 13:35
I can't provide you the code since I don't have a computer but the logic would be 1) loop through the worksheets (which you have done), 2) check `If Right$(ws.Name, 9) = "_Speclist" Then`, 3) if true, declare a string variable and get the spec name `specName = Split(ws.Name, "_")(0)`, 4) Copy the speclist worksheet to a new workbook `ws.Copy` 5) copy the other 2 worksheets. `ThisWorkbook.Worksheets("WBXX" & specName & "_Featurelist").Copy After:=ActiveWorkbook.Worksheets(1)` , `ThisWorkbook.Worksheets("WBXX" & specName & "_Corelist").Copy After:=ActiveWorkbook.Worksheets(2)`. 6) save and close — Raymond Wu, Nov 20 '21 at 13:45
Obviously i couldn't test it so you can give it a try or wait till someone writes a tested answer @Yusuf — Raymond Wu, Nov 20 '21 at 13:46
Thanks @RaymondWu there is a compile error expected: named parameter. I think the issue comes from ThisWorkbook, because, it didn't defined first — Yusuf, Nov 20 '21 at 13:59
Which line did the error occur? `ThisWorkbook` refers to the workbook that the code runs from so it is defined. — Raymond Wu, Nov 20 '21 at 14:06
Sorry it was my fault. I removed (,) in step 5 and tried again. This error has been removed. However, now I am getting Run-time error '9':Subscript out of range error now. When I am closing error dialog box, a new book is being created with only speclist. As far as I understood, spec list is splitted correctly but Feature and Corelist don't merge with new book. — Yusuf, Nov 20 '21 at 14:22
I suppose setting the new workbook to a variable is safer. Please see CDP1802's answer as he has demonstrated that. @Yusuf — Raymond Wu, Nov 20 '21 at 14:24

CDP1802 · Accepted Answer · 2021-11-20T15:16:07.820

Option Explicit

Sub SplitEachWorksheet()

    Dim wb As Workbook, wbNew As Workbook, ws As Worksheet
    Dim num As Collection, n, dict As Object
    Dim FPath As String
    
    FPath = Application.ActiveWorkbook.Path
    
    Set num = new Collection
    Set dict = CreateObject("Scripting.Dictionary")
    Set wb = ThisWorkbook
    For Each ws In wb.Worksheets
       If ws.Name Like "*_Speclist" Then
           num.Add Left(ws.Name, Len(ws.Name) - 9)
       End If
       dict.Add ws.Name, ws.Index
    Next
    
    ' check sheets
    Dim msg As String, s As String
    For Each n In num
        s = "WBXX" & n & "_Corelist"
        If Not dict.exists(s) Then
            msg = msg & vbLf & s & " missing"
        End If
       
        s = "WBXX" & n & "_Featurelist"
        If Not dict.exists(s) Then
            msg = msg & vbLf & s & " missing"
        End If
    Next
    If Len(msg) > 0 Then
       MsgBox msg, vbCritical
       Exit Sub
    End If
    
    ' check workbooks
    Application.ScreenUpdating = False
    For Each n In num
        wb.Sheets(n & "_Speclist").Copy
        Set wbNew = ActiveWorkbook
        wb.Sheets("WBXX" & n & "_Featurelist").Copy after:=wbNew.Sheets(1)
        wb.Sheets("WBXX" & n & "_Corelist").Copy after:=wbNew.Sheets(2)
        wbNew.SaveAs Filename:=FPath & "\" & n
        wbNew.Close False
    Next
    Application.ScreenUpdating = True
    
    ' result
    MsgBox num.Count & " worksbooks created in " & FPath, vbInformation
End Sub

If I may suggest - instead of `Dim num As New Collection`, do `Dim num As Collection: Set num = New Collection`. https://stackoverflow.com/questions/42656468/whats-the-difference-between-dim-as-new-vs-dim-set/42656772#42656772 — Raymond Wu, Nov 20 '21 at 14:59

Splitting Sheets with Same Name Range in One Excel Workbook - Excel VBA

1 Answers1