Public Sub DE_Split()
Application.DisplayAlerts = False
Dim wbFeed As Workbook
Dim wbFeedFileName As String
Dim iRegion As Integer
Dim sRegion As String
Dim iSheets As Integer
Dim sPath As String
Dim sMessage As String
'Sets the original workbook as an object which is referred to throughout the VBA
Workbooks.Open Filename:="C:\Users\xxxx11\Desktop\Reg\CopyFrom\Regional Reports.xls"
Set wbFeed = Application.Workbooks("Regional Reports.xls")
iRegion = 3 'Sets the first Region to work on. The first Region will always start on the third sheet, as the first two sheets are cover sheets
iSheets = (ActiveWorkbook.Worksheets.Count) ' count the total number of sheets (Regions). This gives the end point for the loop
sPath = "C:\Users\xxxx11\Desktop\Reg\CopyFrom" 'Sets the filepath of the original file
wbFeedFileName = Left(wbFeed.Name, (InStrRev(wbFeed.Name, ".", -1, vbTextCompare) - 1)) 'Sets the name of the original workbook
Do While iRegion <= iSheets
sRegion = Sheets(iRegion).Name
Sheets(Array("FrontPage", sRegion)).Select
Sheets(Array("FrontPage", sRegion)).Copy
ActiveWorkbook.SaveAs Filename:=sPath & "\Pre Publishing Holding Folder\" & wbFeedFileName & "_" & sRegion & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
ActiveWorkbook.Close
sMessage = sMessage & wbFeedFileName & "_" & sRegion & ".xlsx" & vbCrLf
'MsgBox (sMessage)
iRegion = iRegion + 1
Loop
End Sub
Bookmarks