Creating a New Workbook

[southcali12]

Hello All!

I need some help with creating a workbook based on unique values in Column C. For every unique value in Column C, I would want a new workbook created and saved as with that unique value's name.

Thank you so much for your help in advance!

Example of what the workbook looks like (p.s. the sheet's name is TOGO):
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Date[/TD]
[TD]Order #[/TD]
[TD]Group[/TD]
[/TR]
[TR]
[TD]5/4/2016[/TD]
[TD]123[/TD]
[TD]Dan[/TD]
[/TR]
[TR]
[TD]5/5/2016[/TD]
[TD]456[/TD]
[TD]John[/TD]
[/TR]
[TR]
[TD]5/5/2016[/TD]
[TD]789[/TD]
[TD]Mary[/TD]
[/TR]
[TR]
[TD]5/6/2016[/TD]
[TD]0123[/TD]
[TD]Jane[/TD]
[/TR]
</tbody>[/TABLE]

Code I found and am working with:
Sub CreateWorkbook()


Rem Copy Data From NRM_Homing_Upload
With ThisWorkbook.Sheets("TOGO")


Dim lRow As Long
lRow = .Range("A" & .Rows.Count).End(xlUp).row


With .Range("A1:C" & lRow)


.AutoFilter 3, "<>"


CopyToNewBook ThisWorkbook, ThisWorkbook.Sheets("TOGO"), .SpecialCells(xlCellTypeVisible), "Unique Value Name"


End With


.AutoFilterMode = False


End With


End Sub


Sub CopyToNewBook(wb As Workbook, ws As Worksheet, rng As Range, sFile As String)


Dim new_book As Workbook
Set new_book = Workbooks.Add


wb.Sheets(ws.name).Range(rng.Address).Copy


With new_book


With .Sheets(1)


.Range("a1").PasteSpecial (xlPasteAll)
.UsedRange.Columns.AutoFit
.UsedRange.RemoveDuplicates Columns:=3, Header:=xlYes


End With


.SaveAs Filename:="C:\Desktop\excel\test\" & sFile & ".xlsx"
.Close


End With


End Sub