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