save Active tab to new workbooks based on value in column

Hi Guys

Some time ago one of the excellent coding guru's here helped me out with a neat macro that would save the active worksheet to a new workbook keeping the original filename and appending the worksheet tab name.

However I was wondering if this macro could be updated to check for values in column B and when the department name changes save them to separate workbooks. Each department is seperated by a blank row.

For example if I had a Workbook called 'MyWorkbook.xls' with a tab called 'MyWorkSheet' then in column B2:B3 'Department A' and in B5:B13 had 'Department B' then the macro would scan column B and save 2 new works sheets called 'MyWorkbook - MyWorkSheet-Department A.xls' and 'MyWorkbook - MyWorkSheet-Department B.xls'

I have included the original code below and I wondered if this could be updated and behaps using the blank rows between departments to let the code know a save should be actioned.

I would be grateful for any assistance.

Thanks.

WorkBook name: 'MyWorkBook.xls'

Sub SaveActiveSht()
    Dim myPathWhereToSave As String
    Dim wbNm   As String
    myPathWhereToSave = "C:\MyFileLocation\"

    wbNm = myPathWhereToSave & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
    Application.ScreenUpdating = False
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=wbNm & " - " & ActiveSheet.Name, _
                          FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                          ReadOnlyRecommended:=False, CreateBackup:=False

    ActiveWorkbook.Close

    Application.ScreenUpdating = True