Split workbook with multiple worksheets by first column entries, into multiple workbooks with same sheets (per entry)

[vtidus]

Good evening to all,

It is very nice to meet you! I would like your help for a vba code to do the following:

I have a workbook containing sheets A, B, C. All sheets have the column "Name" as their first column (there might be multiple lines with the same name).
I would like to split the files per unique name into multiple workbooks all containing the same sheets. I.e. one file would include only John's relevant rows in sheets A, B, C, the next file would only include Mary's etc. until there are individual workbooks for each of the entries of column "Name".

Could you please guide me a little bit or ideally provide a code for this?

Thank you very much!

 

[Fluff]

Hi & welcome to the board
As you haven't given us much info, I've made some assumptions
You have only 3 sheets in your original workbook
You have a header row in row 1
your data starts in A2
All files will be xlsm format & saved in the same folder as the original.
The original workbook will be the active workbook when you run this code

Sub SplitData()

   Dim Cl As Range
   Dim Ky As Variant
   Dim UsdRws As Long
   Dim Wbk As Workbook
   Dim SrcWbk As Workbook
   Dim Ws As Worksheet
   
   Set SrcWbk = ActiveWorkbook
Application.ScreenUpdating = False

   With CreateObject("scripting.dictionary")
      For Each Ws In SrcWbk.Worksheets
         For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
            If Not .exists(Cl.Value) Then .Add Cl.Value, Nothing
         Next Cl
      Next Ws
      For Each Ky In .keys
         Set Wbk = Workbooks.Add
         Wbk.Sheets.Add after:=Sheets(1)
         Wbk.Sheets.Add after:=Sheets(2)
         For Each Ws In SrcWbk.Worksheets
            If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
            Ws.Range("A1").AutoFilter 1, Ky
            Ws.UsedRange.SpecialCells(xlVisible).Copy Wbk.Sheets(Ws.Index).Range("A1")
         Next Ws
         Wbk.SaveAs SrcWbk.Path & "\" & Ky & ".xlsm", 52
         Wbk.Close
      Next Ky
   End With
   For Each Ws In SrcWbk.Worksheets
      Ws.AutoFilterMode = False
   Next Ws
      
End Sub

 

[vtidus]

Whoah!! Works really well! Thank you for your assistance!! Please be well!!

 

[Fluff]

Glad to help & thanks for the feedback