How do I create a seperate .XLSM workbook for each list item?

Sub test()
Dim ra As Range, rdata As Range, unq As Range, cunq As Range, filename As String
Dim filt As Range, wb As String
Application.ScreenUpdating = False
With ActiveWorkbook.Worksheets("sheet1")
Range(.Range("A1").End(xlDown).Offset(1, 0), .Cells(Rows.Count, "A")).Cells.Clear
Set ra = Range(.Range("A1"), .Range("A1").End(xlDown))
Set rdata = .Range("A1").CurrentRegion
Set unq = .Range("A1").End(xlDown).Offset(5, 0)
ra.AdvancedFilter xlFilterCopy, , unq, True
Set unq = Range(unq.Offset(1, 0), unq.End(xlDown))
For Each cunq In unq
filename = cunq
rdata.AutoFilter field:=1, Criteria1:=cunq

Set filt = rdata.SpecialCells(xlCellTypeVisible)

On Error GoTo nextstep
  If FileFolderExists("c:\users\system\destop\" & filename & ".xlsm") Then GoTo nextstep
  Application.DisplayAlerts = False
Workbooks.Add
    ActiveWorkbook.SaveAs filename:="C:\Users\systems\Desktop\" & filename & ".xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        'ActiveWorkbook.Worksheets("sheet1").Range("A1").PasteSpecial
      wb = ActiveWorkbook.Name
    'ActiveWorkbook.Close
   

nextstep:
wb = cunq.Value
Workbooks.Open wb

 filt.Copy
 
With Workbooks(wb)
.Worksheets("sheet1").Range("a1").PasteSpecial
.Save
.Close
End With
 
.AutoFilterMode = False
Application.CutCopyMode = False
Next cunq
End With

MsgBox "macro over"
Application.ScreenUpdating = True
End Sub

Public Function FileFolderExists(strFullPath As String) As Boolean
'Author       : Ken Puls (www.excelguru.ca)
'Macro Purpose: Check if a file or folder exists
    On Error GoTo EarlyExit
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
    
EarlyExit:
    On Error GoTo 0
End Function