Creating multiple worksheets or workbooks from one

Question

I have a spreadsheet with over a thousand rows. The unique identifier is the vendor ID which is located in column B. The data covers from column A to column N. I want to parse this master spreadsheet and create new worksheets or better yet create a new file/workbook by each vendor ID. The spreadsheet does not contain headers. A vendor ID may just have one row or it can have 20 rows of data, 3 rows of data, etc. Lastly, I would like to convert the new file into .CSV format. When creating the new worksheets or files I would like the maintain all the formats from the source spreadsheet. The data contains, amounts, dates, and regular input of characters.

I found the below code on-line a few days ago and modified it for my needs. I was able to get it to work but I do not like how it brings over the .value and I lose the format of the dates and it creates formatting issues for the end result.

I would like to build a code flexible enough where I can modify it to create multiple worksheets within the workbook (with or without headers) or have it flexible enough where I can modify it to create workbooks based off of each vendor ID criteria (or unique criteria if it is used for other purposes). I'm trying to prevent for a user to have to create 168 files or worksheets manually based off of a consolidated worksheet.

Sub AllocatedataCSV()
    Dim ws As Worksheet
    Set ws = Sheets("CSV Master")
    Dim LastRow As Long

    LastRow = Range("B" & ws.Rows.Count).End(xlUp).Row

    ' stop processing if we don't have any data
    If LastRow < 2 Then Exit Sub

    Application.ScreenUpdating = False
    CopyDataToSheets LastRow, ws
    ws.Select
    Application.ScreenUpdating = True
End Sub


Sub CopyDataToSheets(LastRow As Long, src As Worksheet)
    Dim rng As Range
    Dim cell As Range
    Dim Series As String
    Dim SeriesStart As Long
    Dim SeriesLast As Long

    Set rng = Range("B1:B" & LastRow)
    SeriesStart = 2
    Series = Range("B" & SeriesStart)
    For Each cell In rng
        If cell.Value <> Series Then
            SeriesLast = cell.Row - 1
            CopySeriesToNewSheet src, SeriesStart, SeriesLast, Series
            Series = cell.Value
            SeriesStart = cell.Row
        End If
    Next
    ' copy the last series
    SeriesLast = LastRow
    CopySeriesToNewSheet src, SeriesStart, SeriesLast, Series

End Sub

Sub CopySeriesToNewSheet(src As Worksheet, Start As Long, Last As Long, _
                                                        name As String)
    Dim tgt As Worksheet

    If (SheetExists(name)) Then
        MsgBox "Sheet " & name & " already exists. " _
        & "Please delete or move existing sheets before" _
        & " copying data from the Master List.", vbCritical, _
        "Time Series Parser"
        End
    End If

    Worksheets.Add(After:=Worksheets(Worksheets.Count)).name = name
    Set tgt = Sheets(name)


    ' copy data from src to tgt
    tgt.Range("A1:N" & Last).Value = _
    src.Range("A" & Start & ":N" & Last).Value
End Sub

Function SheetExists(name As String) As Boolean
    Dim ws As Worksheet

    SheetExists = True
    On Error Resume Next
    Set ws = Sheets(name)
    If ws Is Nothing Then
       SheetExists = False
    End If
End Function

Answer 1

To copy data and formatting, change:

tgt.Range("A1:N" & Last).Value = _
src.Range("A" & Start & ":N" & Last).Value

to:

src.Range("A" & Start & ":N" & Last).Copy
tgt.Range("A1").PasteSpecial xlPasteAll

To put the copied data into a new workbook:

Sub CopySeriesToNewSheet(src As Worksheet, Start As Long, Last As Long, _
                                                        name As String)

    Dim wb As Workbook : Set wb = Workbooks.Add
    Dim tgt As Worksheet

    Set tgt = wb.Sheets(1)
    tgt.name = name

    src.Range("A" & Start & ":N" & Last).Copy
    tgt.Range("A1:N" & Last).PasteSpecial xlPasteAll
    wb.SaveAs name
    wb.Close
End Sub

UPDATE to answer question in comment

If a source series has only one row, the pasted result will be incorrect. This can be resolved by pasting onto a single cell, so

tgt.Range("A1:N" & Last).PasteSpecial xlPasteAll

becomes

tgt.Range("A1").PasteSpecial xlPasteAll

I've updated my code above to reflect this change.

This can also be resolved in the original code:

tgt.Range("A1:N" & (1+Last-Start)).Value = _
src.Range("A" & Start & ":N" & Last).Value