Option Explicit
Const C = "[bcdfghjklmnpqrstvwxz]"
Const V = "[aeiouyéèëéêôàâûùï]"
Sub ListerMots()
Dim i As Integer
Do While Cells(1, i + 1).Text <> vbNullString
ExtraireMots Cells(1, i + 1)
i = i + 1
Loop
End Sub
Sub ExtraireMots(Cellule As Range)
Dim cnx As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim sql As String, masque As String
Dim i As Byte
If Cellule.Cells.Count > 1 Then Set Cellule = Cellule(1)
For i = 1 To Len(Cellule(1))
masque = Replace(Replace(Cellule(1), "C", C), "V", V)
Next
Range(Cellule(2, 1), Cellule(2, 1).End(xlDown)).Clear
cnx.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & ThisWorkbook.Path & ";" _
& "Extended Properties='text;HDR=Yes;FMT=Delimited';"
cnx.CursorLocation = adUseClient
cnx.Open
rst.Open "SELECT * FROM [Mots.txt] WHERE MOTS Like '" & masque & "';", cnx, adOpenStatic, adLockReadOnly
If rst.State = adStateOpen Then
Cellule(2, 1).CopyFromRecordset rst
rst.Close
End If
cnx.Close
End Sub