Saving split worksheets into specific folders

[micashell]

Hoping someone can help.

I can find code for various parts of what I want to do but I can't find everything.

I have a summary sheet where column A has a list of names. Column C has a list of sheet names. Those sheet names form the rest of the workbook

I want to split the workbook and save the individual sheets with the sheet names as the file name (I have code for this. The code doesn't use column C, it just uses the sheet names). However, those sheet names are in column C in case that makes it easier for someone to create the code

I want to create folders with the names in column A. (I have code for this).

What I am missing is that I want to save the files created into the folders created. These folders will be in one location, I just need the sheets to go into corresponding folder name.

I am not precious about the code I have if someone has something that can spit the workbook, create the folder and save the file in the folder all in one.

All help gratefully received

 

[Fluff]

Hi & welcome to MrExcel
How about

Sub SplitWbk()

   Dim Wbk As Workbook
   Dim Ws As Worksheet
   Dim Pth As String
   
Application.ScreenUpdating = False
   Set Wbk = ActiveWorkbook
   Pth = "C:\MrExcel\test\"
   
   For Each Ws In Wbk.Worksheets
      If Ws.Name <> "Moderation" Then
         If Dir(Pth & Ws.Name, vbDirectory) = "" Then MkDir Pth & Ws.Name
         Ws.Copy
         ActiveWorkbook.SaveAs Pth & Ws.Name & "\" & Ws.Name, 52
         ActiveWorkbook.Close False
      End If
   Next Ws
End Sub

 

[micashell]

Hi Fluff and thank you so much for your speedy response. That code is amazing and it's almost there but it is making the folder name the same as the file name. I need the folder name to read from column A which has a name in it whereas column C has the sheet name in it but the two are not the same. is it possible to amend the above code to fix that?

 

[Fluff]

Do you want the files named as per col A, or as per the sheet name?

 

[micashell]

I'm basically looking for the result c:\desktop\holding folder\column A\sheetname.xlsx - although sheetname.xlsx could be column C.xlsx and it would be the same

 

[Fluff]

Ok, try

Sub SplitWbk()

   Dim Cl As Range
   Dim Pth As String
   
Application.ScreenUpdating = False
   Pth = "C:\MrExcel\test\"
   
   For Each Cl In Range("A3", Range("A" & Rows.Count).End(xlUp))
         If Dir(Pth & Cl.Value, vbDirectory) = "" Then MkDir Pth & Cl.Value
         Sheets(Cl.Offset(, 2).Value).Copy
         ActiveWorkbook.SaveAs Pth & Cl.Value & "\" & Cl.Offset(, 2).Value, 52
         ActiveWorkbook.Close False
   Next Cl
End Sub

 

[micashell]

That works perfectly. Thank you so much for all your help. Really appreciate it

 

[Fluff]

Glad to help & thanks for the feedback