Sub CreerTXT()
Dim chemin$, P As Range, tablo, d As Object, i&, tablo1, x%, j&
chemin = ThisWorkbook.Path & "\"
Set P = [A1].CurrentRegion.Resize(, 2)
tablo = P.Value 'matrice, plus rapide, au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
Application.ScreenUpdating = False
With Workbooks.Add.Sheets(1) 'nouveau document
For i = 2 To UBound(tablo)
If tablo(i, 1) <> "" And Not d.exists(tablo(i, 1)) Then
d(tablo(i, 1)) = ""
.Columns(1).Resize(, 2).Clear
.Cells(2, 3) = "=A2=""" & tablo(i, 1) & """" 'critère
P.AdvancedFilter xlFilterCopy, .Cells(1, 3).Resize(2), .Cells(1) 'filtre avancé
tablo1 = .UsedRange.Resize(, 2)
x = FreeFile
Open chemin & tablo(i, 1) & ".txt" For Output As #x 'ouverture en écriture séquentielle
For j = 2 To UBound(tablo1)
Print #x, tablo(j, 2)
Next j
Close #x
End If
Next i
.Parent.Close False
End With
End Sub