VBA - Copy Worksheets with same Prefix in Name to new Workbook

[Rahul79]

Hello all,

I have a task at hand and am completely unsure on how to proceed. I was able to find a Macro online from "http://bredow.me/index.php/home/visual-basic-for-excel/vb-processes-and-snippets/split-worksheets-into-separate-files/" which is as below.

Here is my scenario. I have a workbook with over 200+ worksheets. So to categorize: 10 - Expense, 10 - FTE, 10 - WLU, 20 - Expense, 20 - FTE and so on.

I am trying to create a new Workbook for each prefix and to include all with those prefix. So, I would have a workbook saved as 10, with 3 worksheets 10 - Expense, 10 - FTE, 10 - WLU and then a Workbook saved as 20 with only 2 worksheets 20 - Expense, 20 - FTE, all saved in a specific location.

At the minimum, each workbook will have 1 worksheet (The Expense Worksheet). The FTE and WLU differ.

I had a Macro for that written several years ago, but then I ran in to KUTools and have been using that for several of my Automated Splits. This one is just tricky.

As I said, I honestly dont know where to start from. My assumption is:

  For Each sht In wbSource.Sheets
        sht.Copy
        Set wbDest = ActiveWorkbook

Here is the whole Macro:

Sub TabsToXlsxFiles()
 
    'Creates an individual workbook for each worksheet in the active workbook.
    Dim wbDest As Workbook
    Dim wbSource As Workbook
    Dim sht As Object 'Could be chart, worksheet, Excel 4.0 macro,etc.
    Dim strSavePath As String
    Dim filePrefix As String
    filePrefix = inputBox("Enter File Prefix if any desired (a space will separate the _
        prefix and the sheet name)", "File Prefix", "", 550, 550)
    fileSuffix = inputBox("Enter File Suffix if any desired (a space will separate the _
        sheet name from the suffix)", "File Suffix", "", 550, 550)
  
    On Error GoTo ErrorHandler
  
    Application.ScreenUpdating = False 'Don't show any screen movement
 
    strSavePath = "C:\Test\excelsplits\" 'Change this to suit your needs
 
    Set wbSource = ActiveWorkbook
  
    For Each sht In wbSource.Sheets
        sht.Copy
        Set wbDest = ActiveWorkbook
        wbDest.SaveAs strSavePath & filePrefix & " " & sht.Name & " " & fileSuffix
        wbDest.Close 'Remove this if you don't want each book closed after saving.
    Next
  
    Application.ScreenUpdating = True
  
Exit Sub
 
ErrorHandler: 'Just in case something bad happens
    MsgBox "An error has occurred. Error number=" & Err.Number & _
        ". Error description=" & Err.Description & "."
End Sub

Any help highly appreciated.

Thanks.