Sub Creer_feuilles_fournisseurs()
Dim chemin$, fournisseurs$, fichier$, Source, n%, d As Object, x%, titre$, texte, code$, a, b, i&, nomfeuille$
chemin = ThisWorkbook.Path & "\"
fournisseurs = chemin & "Fournisseurs\"
If Dir(fournisseurs, vbDirectory) = "" Then MkDir fournisseurs 'crée le sous-dossier
fichier = Dir(fournisseurs & "*.txt")
'---vide le sous-dossier---
While fichier <> ""
Kill fournisseurs & fichier
fichier = Dir
Wend
'---création des fichiers et feuilles fournisseurs---
Source = Array("famrem_sacha_Pour Test.txt", "hzn_sacha_Pour Test.txt") 'à adapter
For n = 0 To UBound(Source)
Set d = CreateObject("Scripting.Dictionary")
x = FreeFile
Open chemin & Source(n) For Input As #x 'ouverture en lecture séquentielle
Line Input #x, titre
While Not EOF(x)
Line Input #x, texte
code = Split(texte, ";")(0) 'code fournisseur
If Not d.exists(code) Then d(code) = titre
d(code) = d(code) & vbLf & texte
Wend
Close #x
a = d.keys: b = d.items
'---création des fichiers---
For i = 0 To UBound(a)
fichier = fournisseurs & "F" & Format(n + 1, "00") & a(i) & ".txt"
x = FreeFile
Open fichier For Output As #x 'ouverture en écriture séquentielle
Print #x, b(i)
Close #x
Next i
'---création des feuilles---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 0 To UBound(a)
nomfeuille = "F" & Format(n + 1, "00") & a(i)
fichier = fournisseurs & nomfeuille & ".txt"
On Error Resume Next
Sheets(nomfeuille).Delete 'supprime la feuille si elle existe
On Error GoTo 0
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = nomfeuille
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=ActiveSheet.Cells(1))
.TextFilePlatform = 65001 'origine UTF-8
.TextFileParseType = xlDelimited
.TextFileSemicolonDelimiter = True
.Refresh
.Parent.Names(.Name).Delete 'supprime le nom défini dans la feuille
.Delete 'supprime la requête
End With
Next i, n
Sheets(1).Activate
End Sub
