Split Worksheet Into Multiple Workbooks (1 Viewer)

[HeelNGville]

I preface this with "Thanks" to any assistance provided. Basically, I have a workbook that contains a single worksheet named "Details". Within this sheet is a column named "Location" (Col B), which will be used as my criteria to perform the split. What I would like to do is create a new workbook (located in the same directory as the master file) on each change in value of the "Location" column (Col B).

Thanks to an old post http://www.mrexcel.com/forum/showthread.php?t=260206&highlight=split+worksheet by J. Windebank , I was able to locate the following code that almost delivers the results:

Public Sub CreateUserFiles()

Dim DataSheet As Worksheet
Dim UserBook As Workbook
Dim UserSheet As Worksheet
Dim Names As New Collection
Dim NameLoop As Long
Dim UniqueName As Boolean
Dim RowLoop As Long
Dim Folder As String

Application.DisplayAlerts = False

Set DataSheet = ActiveSheet
Folder = "C:\Documents and Settings\rewrde5\Desktop\CA Feed\"

For RowLoop = 1 To DataSheet.Range("B65536").End(xlUp).Row

UniqueName = True

For NameLoop = 1 To Names.Count

If DataSheet.Range("B" & RowLoop) = Names(NameLoop) Then

UniqueName = False
Exit For

End If

Next NameLoop

If UniqueName Then

Names.Add DataSheet.Range("B" & RowLoop)

End If

Next RowLoop

For NameLoop = 1 To Names.Count

Set UserBook = Workbooks.Add
Set UserSheet = UserBook.Worksheets.Add

UserSheet.Name = "Details"
UserBook.Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete

For RowLoop = 1 To DataSheet.Range("B65536").End(xlUp).Row

If DataSheet.Range("B" & RowLoop) = Names(NameLoop) Then

DataSheet.Range("C" & RowLoop & ":IV" & RowLoop).Copy

If IsEmpty(UserSheet.Range("A1")) Then

UserSheet.Range("A1").PasteSpecial

Else

UserSheet.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial

End If

End If

Next RowLoop

UserBook.SaveAs Folder & Names(NameLoop) & ".xls"
UserBook.Close False

Next NameLoop

Application.DisplayAlerts = True
MsgBox "Completed Processing", vbInformation, "Finished"

End Sub
The only issue is, the new workbooks that are created do not contain column headings. I am not versed enough in VB to determine the code and where it should be inserted to ensure that the headings are copied to the new workbooks.

As previously mentioned, any assitance would be greatly appreciated.

Regards,
Rick