Combine Worksheets Into New Workbook Based on Criteria and Save - vba

Question

I have a workbook made up with 100+ worksheets. These worksheets have account number/names/days in the name of the worksheet.
The naming convention for the worksheets follows this pattern of AccountNumber/AccountName/Description:
11-Greg-Monday
11-Greg-Tuesday
11-Greg-Friday
38-Rachel-Sunday
38-Rachel-Tuesday
38-Rachel-Saturday
I would like Excel to loop through all the worksheets, and extract all of the 11-Greg worksheets and save into a new workbook named 11-Greg, and then do the same for 38-Rachel, etc. I have a list of the account numbers/names on a worksheet named "Accounts" in the workbook.
Would it be possible to maintain the formulas after the extract of the worksheets, and formatting like column widths?
I found this code that might work to start, but I don't know how to reference the list on the "Accounts" tab to loop through for the account names?
Dim wb as Workbook, sht as WorkSheet
Dim strFileName As String
'Copy sheet as a new workbook
ActiveWorkbook.Sheets("Sheet1").Copy
Set wb = ActiveWorkbook
Set sht = wb.Sheets(1)
'SaveAs
strFileName = Application.GetSaveAsFilename(wb.Name) & "xlsx"
If strFileName = "False" Then Exit Sub 'User Canceled
wb.SaveAs Filename:=strFileName

Answer 1

The easiest way would be to create a list of the names you want to stack on a separate list. set that list as a range and then loop through each cell checking to see if the x letters of the sheet name match. something like this
Sub stacksheets()
Dim rng As Range, cCell As Range
Dim ws As Worksheet
Dim wb As Workbook, wb2 As Workbook
Dim shName As String
Set rng = ActiveWorkbook.Sheets("list").Range("a1:a2") ''this would be the list of names
Set wb2 = ActiveWorkbook ''remembering activeworkbook so can return
For Each cCell In rng
shName = Left(cCell.Value, 5) ''this needs to be the minimum letters from each name that is unique
Set wb = Workbooks.Add
For Each ws In wb2.Sheets
If InStr(ws.Name, shName) > 0 Then ''checks for name in sheet name
ws.Copy after:=wb.Sheets(1)
wb2.Activate
End If
Next ws
wb.SaveAs (wb2.Path & "\" & cCell.Value) '' saves workbook as list name
Next cCell
End Sub