Saving 3 Worksheets as New Workbook

All,

I had a segment of VBA working some time ago, but I've modified the worksheet so much now that the macro doesn't work like it should. I am trying to create a master file that will automatically refresh my reports, and save each department's information as it's own workbook. Every department will have 3 worksheets, so I would like the VBA to take every 3 worksheets and save them as a new file. I'd like the name of the new file to be "(first worksheet name)_(text in cell B5 on the second worksheet).xls". For example, if my 3 worksheets are 44001, 44001_Month, and 44001_Historical and the text in B5 on 44001_Month were September, then it would save all three of those worksheets with the name 44001_September.xls. This is the code I'm currently using:

Selection.Replace What:=What, Replacement:=repl, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Dim xPath As String
Dim xContents As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    For i = 1 To ThisWorkbook.Sheets.Count Step 2
        ThisWorkbook.Sheets(Array(i, i + 1, i + 2)).Copy
        xContents = ActiveWorkbook.Sheets(2).Cells(5, "B").Value
        ActiveWorkbook.SaveAs Filename:=xPath & "\" & ActiveWorkbook.Sheets(1).Name & "_" & xContents & ".xls", FileFormat:=-4143
        Application.ActiveWorkbook.Close False
    Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True

Any help you can give would be great!

Thank you.