Sub CreerFichiers()
    Dim Wkb, Nb%, Chemin$, NomFichier$, DL%, i%, Chaine$
    Application.ScreenUpdating = False
    Nb = 0: Chaine = ""
    Chemin = CurDir & "\"                                   ' A adapter suivant besoin
    DL = 1 + Range("A65500").End(xlUp).Row                  ' Colonne A à adapter
    For i = 1 To DL
        If Cells(i, "A") <> "" Then                         ' Colonne A à adapter
            NomFichier = Cells(i, "A") & ".xlsx"            ' Extension A à adapter
            If FichierExiste(Chemin & NomFichier) = False Then  ' Si le fichier n'existe pas
                Set Wkb = Workbooks.Add
                Wkb.SaveAs Chemin & NomFichier              ' Sauvegarde fichier
                Workbooks(NomFichier).Close                 ' Ferme fichier
                Chaine = Chaine & NomFichier & Chr(10)      ' Prépar message de sortie
                Nb = Nb + 1                                 ' Compte le nombre de fichiers crées.
                Application.StatusBar = "Nombre de fichiers créés : " & Nb
            End If
        End If
    Next i
    Application.ScreenUpdating = True
    Application.StatusBar = ""
    If Nb = 0 Then
        MsgBox "Tous les fichiers existent déjà."
    Else
        MsgBox "Fichiers crées dans " & Chemin & Chr(10) & Chr(10) & Nb & " fichier(s) créé(s) :" & Chr(10) & Chaine
    End If
End Sub
Function FichierExiste(Fichier As String)
' Renvoie True si le fichier existe, False s'il n'existe pas
On Error GoTo Fin:
   If Fichier <> "" And Len(Dir(Fichier)) > 0 Then
      FichierExiste = True
   Else
      FichierExiste = False
   End If
Exit Function
Fin:
    FichierExiste = CVErr(xlErrRef)
End Function