Copy and rename file from list

Sub CopyToEachName()
    Dim cell As Range
     ThisWorkbook.Save
    For Each cell In Worksheets("Sheet6").Range("A2", _
        Worksheets("Sheet6").Range("A2").End(xlDown))
        ThisWorkbook.SaveCopyAs _
            ThisWorkbook.Path & Application.PathSeparator & cell.Value & ".xls"
    Next cell
End Sub

Sub Sheet6CopyToEachName()
    Dim sWB0 As String
    Dim a, v
    
    ThisWorkbook.Save
    sWB0 = ThisWorkbook.FullName
     
     a = Worksheets("Sheet6").Range("A2", _
        Worksheets("Sheet6").Range("A2").End(xlDown))
        
    ThisWorkbook.Save
    Application.DisplayAlerts = False
    Worksheets("Sheet6").Delete
    Application.DisplayAlerts = True
    
    For Each v In a
        ThisWorkbook.SaveCopyAs _
            ThisWorkbook.Path & Application.PathSeparator & v & ".xls"
    Next v
    
    Application.DisplayAlerts = False
    Workbooks.Open sWB0
    Application.DisplayAlerts = True
End Sub