Create Subfiles from a master file using key to split workbooks to seperate files

[balla506]

Hi,


I am trying to make my macro more dynamic for a spreadsheet I am working on. I have this code which splits out worksheets (using the specific names of the worksheets-not dynamic) from a main workbook into template workbooks (which are basically just an empty workbook because I didn't know how else to do it) and then saves them using the paths below. I would like to make this more dynamic by splitting the different worksheets into new workbooks based on a key column in the hierarchy worksheet. Basically I have a list of accounts in column B with the file name they should be exported to in column A. There are about 30 accounts being split into 6 different region files. Also note that the same account might be listed multiple times in column A (needed to add multiple numbers for other lookup formulas in the worksheets) but that account worksheet will still only be going to one of the six region files and not to multiple regions. After these are copied to an individual file I would like to save it to a location on my computer. All files will go to this location. Any help on this is much appreciated. Thanks.

Sub Create_Subfiles()


Dim FDMName As String
Dim FBName As String
Dim DIYName As String
Dim WMName As String
Dim FPath As String
Dim BWName As String

'File names and directory path
FDMName = Workbooks("Sales Forecast Template.xlsm").Sheets("Hierarchy").Range("f14").Value
FBName = Workbooks("Sales Forecast Template.xlsm").Sheets("Hierarchy").Range("f13").Value
DIYName = Workbooks("Sales Forecast Template.xlsm").Sheets("Hierarchy").Range("f15").Value
WMName = Workbooks("Sales Forecast Template.xlsm").Sheets("Hierarchy").Range("f12").Value
TOTName = Workbooks("Sales Forecast Template.xlsm").Sheets("Hierarchy").Range("f16").Value
FPath = "C:/desktop"












'open template files
Workbooks.Open Filename:= _
"P:\Sales\SalesFinance\Sales Forecast\Template\Template Files\1.xlsm"
Workbooks.Open Filename:= _
"P:\Sales\SalesFinance\Sales Forecast\Template\Template Files\2.xlsm"
Workbooks.Open Filename:= _
"P:\Sales\SalesFinance\Sales Forecast\Template\Template Files\3.xlsm"
Workbooks.Open Filename:= _
"P:\Sales\SalesFinance\Sales Forecast\Template\Template Files\4.xlsm"
Workbooks.Open Filename:= _
"P:\Sales\SalesFinance\Sales Forecast\Template\Template Files\Total.xlsm"
Windows("Sales Forecast Template.xlsm").Activate


'move worksheets to proper workbooks and save them to correct directory
Sheets(Array("Sheet1", "Sheet 2").Sheets(1)
Sheets(Array("Hierarchy", "Couponing", "Sheet1")).Select
Sheets("Sheet1").Activate
ActiveWindow.SelectedSheets.Visible = False
Range("A2").Select
ActiveWorkbook.SaveAs Filename:=FPath & "\" & FDMName, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close False
Windows("Sales Forecast Template.xlsm").Activate

Sheets(Array("Sheet 5", "Sheet 7").Sheets(1)
Sheets(Array("Hierarchy", "Couponing", "Sheet1")).Select
Sheets("Sheet1").Activate
ActiveWindow.SelectedSheets.Visible = False
Range("A2").Select
ActiveWorkbook.SaveAs Filename:=FPath & "\" & FBName, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close False
Windows("Sales Forecast Template.xlsm").Activate








ThisWorkbook.Close False
End Sub