VBA - Move sheets to new workbook based on first three letters of sheet name

[sharkmeister]

Hi

I've searched the forum and found topics about moving sheets but my request is slightly more specific.

I'm very new to VBA and learning as I go along.

I've got a workbook with about 600 tabs. Each tab is named with a three letter code then a rep number and name e.g ABC-1-repname

I need to use a range to specify the three letter codes of which there are about 60. I then need to do the following for each code in the range:

1) Select the sheets relevant to each individual code
2) Move selected sheets to new workbook
3) Save workbook as a specific name using the 3 letter code e.g. ABC Sales November 2021

I need to do this for all 60 codes.

Anyone able to help with a solution for this please.

Thank you in advance

 

[PeteWright]

Hi, I've got two questions:

1. Is this an one-time task or repetitive?
For an one-time task maybe this can be done with the use of some tools like ASAP-Utilities, Kutools or Professor Excel.
2. Could you give a few examples? So I will get a picture of what you're trying to achieve.

 

[sharkmeister]

Hi Pete

It’s something have to do each month.

I have a macro that splits a data set into a tab for each rep hence the 600 tabs.

Basically I need to create 60 workbooks with the tabs relevant to each three letter code.

Eg code ABC may have 3 tabs that make up the book, DEF may have 10 tabs that make up the book and so on.

Then then need to be saved into their relevant workbook using the 3 letter prefix and a consistent file name. Workbook one = ABC Sales November 2021, workbook two = DEF Sales November 2021 and so on.

I was looking at the utilities as they would probably help do the job but I’m tying to learn VBA so I can understand it.

 

[mikerickson]

I would use a logic something like

Dim aCell as Range
Dim oneSheet as Worksheet
Dim blnReplace as Boolean

For Each aCell in ListOfCodes
    blnReplace = True
    For Each oneSheet in ThisWorkbook.Worksheets
        If LCase(oneSheet.Name) Like LCase(aCell.Value) & "*" Then
            oneSheet.Select Replace:=blnReplace
            blnReplace = False
        End If
    Next oneSheet

    ActiveWindow.SelectedSheets.Copy
    ActiveWorkbook.SaveAs myFilePath & "." & "dataFrom" & aCell.Value & ".xlsm": Rem adjust to match your filepath and naming convention

    ThisWorkbook.Activate
Next oneCell

 

[Fluff]

Hi & welcome to MrExcel.
How about, this will save all the sheets based on the 1st 3 characters of their name.

Sub sharkmeister()
   Dim Dic As Object
   Dim ws As Worksheet
   Dim Sht As String, x
   Dim i As Long
  
   Application.ScreenUpdating = False
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = 1
   For Each ws In Worksheets
      Sht = Left(ws.Name, 3)
      If Not Dic.Exists(Sht) Then
         Dic.Add Sht, ws.Name
      Else
         Dic(Sht) = Dic(Sht) & "|" & ws.Name
      End If
   Next ws
   For i = 0 To Dic.Count - 1
      Sheets(Split(Dic.items()(i), "|")).Copy
      Application.DisplayAlerts = False
      With ActiveWorkbook
         .SaveAs "C:\MrExcel\Fluff\" & Dic.Keys()(i) & " Sales " & Format(Date, "mmmm yyyy"), 51
         .Close
      End With
   Next i
   Application.DisplayAlerts = True
End Sub

 

[sharkmeister]

Thanks for the welcome and help @mikerickson and @Fluff, will give both suggestions a try and see how I go.