Il y en a plus que nécessaire car les règles M106T ne sont plus ce qu'elles étaient au début ...
avec la détection des lignes en (M0), (M00) cela devient complexe
Option Explicit
Dim ligne As Long
Sub importer()
Dim chemin$, Rep As FileDialog
' choix du répertoire
Set Rep = Application.FileDialog(msoFileDialogFolderPicker)
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire des fichiers ..."
Rep.Show
If Rep.SelectedItems.Count = 0 Then Exit Sub
chemin = Rep.SelectedItems(1) & "\"
' effacement données
If Not ActiveSheet.ListObjects(1).DataBodyRange Is Nothing Then ActiveSheet.ListObjects(1).DataBodyRange.Delete
' lecture
ligne = 2
lire chemin
End Sub
Sub lire(chemin As String)
Dim fso, SourceFolder, SubFolder
Dim fichier$, ContenuLigne$, avant$, apres$, flag As Boolean
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(chemin)
fichier = Dir(chemin)
Do While fichier <> ""
Open chemin & fichier For Input As #1
avant = "": apres = "": flag = False
Do While Not EOF(1)
Line Input #1, ContenuLigne
' la ligne précédente a été détectée comme (M0), (M00) etc.
' on indique alors le contenu de la ligne si c'est un commentaire
If flag Then
If ContenuLigne Like "(*)" Then
apres = ContenuLigne
Cells(ligne, 4) = apres
flag = False
End If
ligne = Range("A" & Rows.Count).End(xlUp).Row + 1
End If
If ContenuLigne Like "(M0*)" Then ' ligne commentaire
flag = True
Cells(ligne, 1) = fichier
Cells(ligne, 2) = ContenuLigne
Cells(ligne, 3) = avant ' ligne avant
Else ' sinon recherche outil
If ContenuLigne Like "*M106*" Or ContenuLigne Like "*M06*" Or ContenuLigne Like "*M6*" Then
Cells(ligne, 1) = fichier
Cells(ligne, 2) = ContenuLigne
ligne = Range("A" & Rows.Count).End(xlUp).Row + 1
End If
End If
' on conserve la ligne avant si c'est un commentaire
If ContenuLigne Like "(*)" Then
avant = ContenuLigne
Else
avant = ""
End If
Loop
Close #1
fichier = Dir
Loop
For Each SubFolder In SourceFolder.subfolders
lire SubFolder.Path & "\"
Next SubFolder
End Sub