Edit Code to Paste to New Workbook

[Alex O]

My code below is functioning just as I'd hoped...almost! I'd like the files to be created in new workbooks rather than sheets.
Can someone assist me with the necessary edit to accomplish said result?

Thanks

Sub parse_data()Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 13
Set ws = Sheets("Report")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:L10"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub

 

[Fluff]

How about

Sub parse_data()
   Dim UsdRws As Long
   Dim Ws As Worksheet
   Dim Wbk As Workbook
   Dim Cl As Range

Application.ScreenUpdating = False
   Set Ws = Sheets("Report")
   If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
   UsdRws = Ws.Cells(Ws.Rows.Count, 13).End(xlUp).Row
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("M2:M" & UsdRws)
         If Not .Exists(Cl.Value) Then
            .Add Cl.Value, Nothing
            Ws.Range("A1").AutoFilter 13, Cl.Value
            Set Wbk = Workbooks.Add(1)
            Ws.UsedRange.SpecialCells(xlVisible).Copy Wbk.Sheets(1).Range("A1")
            Wbk.SaveAs ThisWorkbook.path & "\" & Cl.Value, 52
            Wbk.Close False
         End If
      Next Cl
   End With
            
End Sub

 

[Alex O]

Thanks for the prompt response!
I think this could work, however, I'm getting "method of range class failed" error at

Ws.Range("A1").AutoFilter 13, Cl.Value

 

[Fluff]

What row is your header data in & what is the last used column?

 

[Alex O]

The headers are on row 10 and the last column is N

 

[Fluff]

In that case, how about

Sub parse_data()
   Dim UsdRws As Long
   Dim Ws As Worksheet
   Dim Wbk As Workbook
   Dim Cl As Range

Application.ScreenUpdating = False

   Set Ws = Sheets("Report")
   
   If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
   UsdRws = Ws.Cells(Ws.Rows.Count, 13).End(xlUp).Row
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("M2:M" & UsdRws)
         If Not .Exists(Cl.Value) Then
            .Add Cl.Value, Nothing
            Ws.Range("A10:N10").AutoFilter 13, Cl.Value
            Set Wbk = Workbooks.Add(1)
            Ws.Range("A10:N" & UsdRws).SpecialCells(xlVisible).Copy Wbk.Sheets(1).Range("A1")
            Wbk.SaveAs ThisWorkbook.path & "\" & Cl.Value, 52
            Wbk.Close False
         End If
      Next Cl
   End With
            
End Sub

 

[Alex O]

I really appreciate all the effort, but now I'm getting runtime error 1004 file could not be accessed at

Wbk.SaveAs ThisWorkbook.Path & "\" & Cl.Value, 52

 

[Fluff]

What is the value of Cl when you get the error?