Macro import fichier .txt nouveau onglet et recap

[st007]

Bonjour et merci a celles ou ceux qui prendront le temps de me lire. Et comme j'ai lu souvent si en plus vous avez une solution à proposer....

Voila ce que j'ai su faire à l'aide de l'enregistreur de macro.

à l'exécution de la macro, excel importe le fichier "I9000001" qu'il colle dans l'onglet du même nom.

quand je reviens sur l'onglet "Résultats", par une succession de recherchev, mes colonnes se remplissent.

mon soucis est le temps d'ouverture du fichier ainsi que le temps de calcul ou d'exécution.

La ligne I9000004 et l'onglet I9000004 a titre d'exemple,

il est certainement possible de simplifier la macro mais depuis que je parcours ce forum, je coule.....

Mes soucis sont :
un chemin de dossier contenant les fichiers texte pouvant se trouver sur différents lecteurs
un nombre de fichiers texte évoluant de 1 à 100
mes fichiers texte ne contiennent pas nécessairement de valeur correspondante a mes colonnes de la feuille résultats

J'aurai souhaiter :
qu'excel demande une fois le chemin du dossier (examen) contenant les fichiers texte (aujourd'hui nommé I9000001, I9000002, .... mais qui peuvent par exemple s'appeler XA00001, XA00002, ...)
crée autant d'onglets que de fichier txt avec pour nom d'onglet le nom du fichier txt en gardant le format d'import de l'I9000004

mes recherchev ne fonctionneront évidement plus quand les onglets ne s’appelleront plus I900000X

Actuellement, je dois renommer mes fichiers txt avant de lancer la macro et utiliser le même dossier sur le disque, c'est là le plus gros soucis, quand je change de pc, il ne m'est pas toujours possible d'obtenir le même chemin pour mon dossier contenant les ".txt" et je n'ai pas forcément de programme pour renommer mes "txt" par lots.

encore merci d'avance

 

[Tirou]

Re : Aide pour simplifier macro

Coucou,

Voilà un petit exemple de syntaxe possible. De quoi t'aider en attendant que quelqu'un ait le temps de t'aider plus précisément.

ub Extraction_Sources()

Application.ScreenUpdating = False
'---------------------------------------------
'------ Definition des chemins d'acces -------
'---------------------------------------------
sourceFolder = ActiveWorkbook.Path & "\Nomenclatures_sources\" 'indiquer ici le chemin du répertoire
traiteFolder = ActiveWorkbook.Path & "\Nomenclatures_traitees\" 'indiquer ici le chemin du répertoire



'---------------------------------------------
'------ Traitement des fichiers source -------
'---------------------------------------------

'------ Boucle sur chaque fichier ------------
nfile = Dir(sourceFolder)
Do Until nfile = ""
    Set FileTarget = Workbooks.Add
    Set FileSource = Workbooks.Open(sourceFolder & nfile)
    FileSourceEndLine = Range("A65000").End(xlUp).Row
    
    With FileTarget.Sheets(1)
        'Ce que tu veux faire
        End With
    
    '-----------------------------------------------------------
    '--------Sauvegarde et fermeture ---------------------------
    FileTarget.SaveAs Replace(traiteFolder & nfile, ".ET", "") & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    FileTarget.Close
    FileSource.Close
    '------- Fichier suivant ------------------------------------
    nfile = Dir()
    Loop
End Sub

 

[Robert]

Re : Aide pour simplifier macro

Bonjour St007, Tirou, bonjour le forum,

Une proposition non terminée (désolé)... Comme le chemin d'accès est variant, le code propose d'ouvrir la boîte de dialogue Ouvrir qui permet à l'utilisateur de sélectionner un fichier (peu importe lequel) du dossier Examen. C'est ce clic qui va déterminer le chemin d'accès. À partir de là, une boucle sur tous les fichiers .TXT du dossier source ce fait. Si le classeur ne contient pas d'onglet portant le nom du fichier, l'onglet est créer.
Il ne reste qu'à copier le texte du fichier f et le copier dans l'onglet od. mais ça je ne sais pas faire...
Le code :

Public Sub Macro1()
Dim fi As String 'déclare la variable fi (FIchier)
Dim nct As Byte 'déclare la variable nct (Nombre de Caracteres Total)
Dim ncc As Byte 'déclare la variable ncc (Nombre de Caracteres du Chemin)
Dim ch As String 'déclare la variable ch (CHemin d'àccès)
Dim sf As Object 'déclare la variable sf (Système de Fichiers)
Dim d As Object 'déclare la variable d(Dossier)
Dim fs As Object 'déclare la variable fs (FichierS)
Dim f As Object 'déclare la variable f (Fichier)
Dim no As String 'déclare la variable no (Nom Onglet)
Dim od As Objectt 'déclare la variable od (Onglet Destination)


fi = Application.GetOpenFilename(MultiSelect:=True)(1) 'définit le fichier fi (n'importe quel fichier de la liste)
nct = Len(fi) 'définit la nombre de caractères total nct
ncc = nct - Len(Split(fi, "\")(UBound(Split(fi, "\")))) 'définit le nombre de caractère du chemin ncc
ch = Left(fi, ncc) 'définit le chemin d'accès du fichier fi
Set sf = CreateObject("Scripting.FileSystemObject") 'définit le système de fichiers sf (accès aux fichiers)
Set d = sf.GetFolder(ch) 'définit le dossier cible d
Set fs = d.Files 'définit l'ensembles des fichiers contenus dans le dossier cible
If fs.Count > 0 Then 'condition : si le nombre de fichiers contenus dans d est suppérieur à 0
    For Each f In fs 'boucle 1 : sur tous les fichiers du dossier d
        If f.Type = "Document texte" Then no = Left(f.Name, Len(f.Name) - 4) 'si le fichier a une extension .TXT, définit le nom de l'onglet no (nom du fichier sans l'extension)
        For Each o In Sheets 'boucle 2 : sur tous les onglets du classeur
            If o.Name = no Then GoTo suite 'si l'onglet no existe, va à l'étiquette "suite"
        Next o 'prochain onglet du classeur (boucle 2)
        Sheets.Add After:=Sheets(Sheets.Count) 'ajoute un nouvel onglet
        ActiveSheet.Name = no 'nomme le nouvel onglet
suite: 'étiquette
        Set od = Sheets(no) 'définit l'onglet de destination od
        od.Select 'sélectionne l'onglet de destination od
        
        'le fichier source en .txt est f, l'onglet destination est od mais je ne sais pas récupérer le texte de l'un pour le placer dans l'autre
    
    Next f 'prochain fichier du dossier d (boucle 1)
End If 'fin de la condition
End Sub

 

[st007]

Re : Aide pour simplifier macro

Merci tirou et robert de vous être penchés sur mon cas,
j'ai ajouté une version 97-2003 au zip
l'option de robert me plait beaucoup car elle répond très bien à mon soucis de chemin d'accès.
excellent début,

je ne reste pas les bras croisés, mais mes connaissances en vba sont nulles

 

[st007]

Re : Aide pour simplifier macro

J'essaie maintenant de renommer automatiquement les onglets créés car comme je le disais, certains fichiers texte s'appellent XA0001, XA0002, ....au lieu de I9000001.....

mes les recherchev ne reconnaissent pas le nom attribué aux onglets grrrrrrrrrrrr...
je coule toujours,

une bonne âme passe-t-elle par ce fil ?

 

[Robert]

Re : Aide pour simplifier macro

Bonsoir le fil, bonsoir le forum,

Le code que je t'ai proposé effectue ce "renommage" d'onglet... Peut-être devrais-tu nous donner ton code pour voir où se trouve le problème.

 

[st007]

Re : Aide pour simplifier macro

Bonsoir tout le monde,

Robert, ton code fonctionne exactement comme je l'espérais, les onglets créés portent le nom du fichier .txt

mon problème est que sur ma feuille résultats, les valeurs s'obtiennent par recherchev
et bizarement, la référence à la feuille I9000001!A:F me renvoie systématiquement #REF!
or, quand je clic dans la barre de formule, sélectionne la plage de recherche, puis clic sur l'onglet et sélectionne la plage, puis enter,

la recherche fonctionne comme escomptée.
j'utilisais cette macro pour compléter les cellules de mes onglets (un morceau)
Sub Collecte1_25()
Sheets("I9000001").Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\Documents and Settings\examen\I9000001.txt" _
, Destination:=Range("$A$1"))
.Name = "I9000001"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(13, 4, 12, 45)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("I9000002").Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\Documents and Settings\examen\I9000002.txt" _
, Destination:=Range("$A$1"))
.Name = "I9000002"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(13, 4, 12, 45)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Résultats").Select
Range("A3").Select
ActiveWorkbook.RefreshAll
Calculate
End Sub

celle-ci fonctionne toujours, mais ma feuille résultats reste avec #REF! même si je recalcul la feuille, ou le classeur.

a te lire
et merci encore du temps que tu passes sur mon cas

 

[Robert]

Re : Aide pour simplifier macro

Bonsoir le fil, bonsoir le forum,

J'avais essayé d'intégrer ton code dans le mien mais ça plantait... En plus, ta partie est pour moi complètement inconnue. Après pas mal de déconvenues j'ai, je pense réussi...
Le code :

Public Sub Macro1()
Dim fi As String 'déclare la variable fi (FIchier)
Dim nct As Byte 'déclare la variable nct (Nombre de Caracteres Total)
Dim ncc As Byte 'déclare la variable ncc (Nombre de Caracteres du Chemin)
Dim ch As String 'déclare la variable ch (CHemin d'àccès)
Dim sf As Object 'déclare la variable sf (Système de Fichiers)
Dim d As Object 'déclare la variable d(Dossier)
Dim fs As Object 'déclare la variable fs (FichierS)
Dim f As Object 'déclare la variable f (Fichier)
Dim no As String 'déclare la variable no (Nom Onglet)
Dim od As Object 'déclare la variable od (Onglet Destination)

fi = Application.GetOpenFilename(MultiSelect:=True)(1) 'définit le fichier fi (n'importe quel fichier de la liste)
nct = Len(fi) 'définit la nombre de caractères total nct
ncc = nct - Len(Split(fi, "\")(UBound(Split(fi, "\")))) 'définit le nombre de caractère du chemin ncc
ch = Left(fi, ncc) 'définit le chemin d'accès du fichier fi
Set sf = CreateObject("Scripting.FileSystemObject") 'définit le système de fichiers sf (accès aux fichiers)
Set d = sf.GetFolder(ch) 'définit le dossier cible d
Set fs = d.Files 'définit l'ensembles des fichiers contenus dans le dossier cible
If fs.Count > 0 Then 'condition : si le nombre de fichiers contenus dans d est suppérieur à 0
    For Each f In fs 'boucle 1 : sur tous les fichiers du dossier d
        If f.Type = "Document texte" Then no = Left(f.Name, Len(f.Name) - 4) 'si le fichier a une extension .TXT, définit le nom de l'onglet no (nom du fichier sans l'extension)
        For Each o In Sheets 'boucle 2 : sur tous les onglets du classeur
            If o.Name = no Then GoTo suite 'si l'onglet no existe, va à l'étiquette "suite"
        Next o 'prochain onglet du classeur (boucle 2)
        Sheets.Add After:=Sheets(Sheets.Count) 'ajoute un nouvel onglet
        ActiveSheet.Name = no 'nomme le nouvel onglet
suite: 'étiquette
        Set od = Sheets(no) 'définit l'onglet de destination od
        od.Select 'sélectionne l'onglet de destination od
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & ch & f.Name, Destination:=Range("$A$1"))
            .Name = no
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 932
            .TextFileStartRow = 1
            .TextFileParseType = xlFixedWidth
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
            .TextFileFixedColumnWidths = Array(13, 4, 12, 45)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        Sheets("Résultats").Select
        Range("A3").Select
        ActiveWorkbook.RefreshAll
        Calculate
    Next f 'prochain fichier du dossier d (boucle 1)
End If 'fin de la condition
End Sub

[Édition]
Ouais ! tu parles d'une réussite... Les formules ne fonctionnent toujours pas ! Pourquoi ne les mettrions-nous pas en place par macro ?

 

[Robert]

Re : Aide pour simplifier macro

Bonsoir le fil, bonsoir le forum,

Enfin une vraie solution avec le code ci-dessous. D'abord, les anciennes données de l'onglet Résultats sont effacées. Ensuite la macro remet les formules quels que soient les noms des fichiers txt...
Le code :

Public Sub Macro1()
Dim fi As String 'déclare la variable fi (FIchier)
Dim nct As Byte 'déclare la variable nct (Nombre de Caracteres Total)
Dim ncc As Byte 'déclare la variable ncc (Nombre de Caracteres du Chemin)
Dim ch As String 'déclare la variable ch (CHemin d'àccès)
Dim sf As Object 'déclare la variable sf (Système de Fichiers)
Dim d As Object 'déclare la variable d(Dossier)
Dim fs As Object 'déclare la variable fs (FichierS)
Dim f As Object 'déclare la variable f (Fichier)
Dim no As String 'déclare la variable no (Nom Onglet)
Dim od As Object 'déclare la variable od (Onglet Destination)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim i As Byte 'déclare la variable i (Incrément)

Sheets("Résultats").Range("A3").CurrentRegion.Offset(3, 0).ClearContents 'efface les anciennes données
fi = Application.GetOpenFilename(MultiSelect:=True)(1) 'définit le fichier fi (n'importe quel fichier de la liste)
nct = Len(fi) 'définit la nombre de caractères total nct
ncc = nct - Len(Split(fi, "\")(UBound(Split(fi, "\")))) 'définit le nombre de caractère du chemin ncc
ch = Left(fi, ncc) 'définit le chemin d'accès du fichier fi
Set sf = CreateObject("Scripting.FileSystemObject") 'définit le système de fichiers sf (accès aux fichiers)
Set d = sf.GetFolder(ch) 'définit le dossier cible d
Set fs = d.Files 'définit l'ensembles des fichiers contenus dans le dossier cible
If fs.Count > 0 Then 'condition : si le nombre de fichiers contenus dans d est suppérieur à 0
    For Each f In fs 'boucle 1 : sur tous les fichiers du dossier d
        If f.Type = "Document texte" Then no = Left(f.Name, Len(f.Name) - 4) 'si le fichier a une extension .TXT, définit le nom de l'onglet no (nom du fichier sans l'extension)
        For Each o In Sheets 'boucle 2 : sur tous les onglets du classeur
            If o.Name = no Then GoTo suite 'si l'onglet no existe, va à l'étiquette "suite"
        Next o 'prochain onglet du classeur (boucle 2)
        Sheets.Add After:=Sheets(Sheets.Count) 'ajoute un nouvel onglet
        ActiveSheet.Name = no 'nomme le nouvel onglet
suite: 'étiquette
        Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
        With Sheets("Résultats") 'prend en compte l'onglet "Résultats"
            Set dest = .Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest
            dest.Value = no 'place le nom de l'onglet dans dest
            For i = 1 To 33 'boucle sur le décalage à droite de 1 à 33 colonnes
                Select Case i 'agit en fonction du décalage à droite
                    Case 1 To 11, 13, 14, 16 To 33 'décalage de 1 à 11, 13, 14, 16 à 33 colonnes
                        'place la fomule
                        dest.Offset(0, i).Formula = "=VLOOKUP(" & Chr(34) & Left(.Cells(2, i + 1).Value, 13) & Chr(34) & "," & no & "!A:F,5,False)"
                    Case 12 'décalage de 12 colonnes
                        'place la formule
                        dest.Offset(0, i).FormulaR1C1 = "=IF(ISNA(RC[3]),0.1*RC[2]/((RC[4]*RC[4]/100)*((RC[-6]*RC[-6])/(RC[-8]*RC[-8]))),0.1*RC[2]/((RC[3]*RC[3]/100)*((RC[-6]*RC[-6])/(RC[-8]*RC[-8]))))"
                    Case 15 'décalage de 12 colonnes
                        'place la formule
                        dest.Offset(0, i).Formula = "=RIGHT(VLOOKUP(" & Chr(34) & Left(.Cells(2, i + 1).Value, 13) & Chr(34) & "," & no & "!A:F,5,False),3)"
                End Select 'fin de l'action en fonction du...
            Next i 'prochaine colonne de la boucle
        End With 'fin de la prise en compte de l'onglet "Résultats"
        Set od = Sheets(no) 'définit l'onglet de destination od
        od.Select 'sélectionne l'onglet de destination od
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & ch & f.Name, Destination:=Range("$A$1"))
            .Name = no
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 932
            .TextFileStartRow = 1
            .TextFileParseType = xlFixedWidth
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
            .TextFileFixedColumnWidths = Array(13, 4, 12, 45)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        Sheets("Résultats").Select
        Range("A3").Select
        ActiveWorkbook.RefreshAll
        Calculate
    Next f 'prochain fichier du dossier d (boucle 1)
End If 'fin de la condition
Sheets("Résultats").Select
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Le fichier :

 

[st007]

Re : Aide pour simplifier macro

PUUUUUUUnaise, je m'empresse d'essayer ce qui semble être un petit bijoux
..
..
..
jusqu'ici aucun soucis, une certaine lenteur d'exécution, mais je ne suis pas équipé d'une bête de course.

je te tiens au courant .
Excel lente nuit.

 

[st007]

Re : [Résolu] Aide pour simplifier macro

Bonjour tout le monde,

Avec un grand MERCI à Robert, j'ai indiqué cette discussion comme résolue car la macro de Robert répond exactement à ce que je souhaitais.

je cherches encore à la comprendre, pour savoir la modifier a mes besoins évolutifs..

bonne journée

 

[st007]

Re : Macro import fichier .txt nouveau onglet et recap

Bonjour à tous et à toutes,

La macro de Robert ci-dessus fonctionne parfaitement pour mes besoins, le seul point noir, c'est sa lenteur,
jusqu’à 70 fichiers .txt, c'est raisonnable (environs 1 minute)
mais l'évolution fait que j'ai plus souvent entre 100 et 200 fichiers et là, je me demandes souvent si excel n'est pas planté ??
J'y ai apporté quelques modifications : créé cinq colonnes vides, supprimé la formule IF de la colonne 12 et ajouté un petit morceau de code qui copie toute la feuille Résultat pour recoller que les valeurs et supprimer tous les onglets créés pour alléger la taille du fichier, et aussi enlevé ActiveWorkbook.RefreshAll et Calculate
en fin de macro qui m'a déjà bien réduit le délai, mais çà reste aux allentours des 5 min.

question : est-ce améliorable
que pensez vous de ces idées :
remplacer reverchev par index equiv ou sommeprod
limiter les recherchev à 300 lignes
une barre de progression m'a bien effleuré, mais le vba et moi ...
la machine sur lequel s'exécute cette macro semble n'avoir aucune influence (excel 32bits avec core 2 duo ou excel 32 bits avec I5), bizarre non? mais c'est le même excel 2007 32bits...

voici le code que j'utilise désormais

Public Sub Macro1()
Dim fi As String 'déclare la variable fi (FIchier)
Dim nct As Byte 'déclare la variable nct (Nombre de Caracteres Total)
Dim ncc As Byte 'déclare la variable ncc (Nombre de Caracteres du Chemin)
Dim ch As String 'déclare la variable ch (CHemin d'àccès)
Dim sf As Object 'déclare la variable sf (Système de Fichiers)
Dim d As Object 'déclare la variable d(Dossier)
Dim fs As Object 'déclare la variable fs (FichierS)
Dim f As Object 'déclare la variable f (Fichier)
Dim no As String 'déclare la variable no (Nom Onglet)
Dim od As Object 'déclare la variable od (Onglet Destination)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim i As Byte 'déclare la variable i (Incrément)

Sheets("Résultats").Range("A3").CurrentRegion.Offset(3, 0).ClearContents 'efface les anciennes données
fi = Application.GetOpenFilename(MultiSelect:=True)(1) 'définit le fichier fi (n'importe quel fichier de la liste)
nct = Len(fi) 'définit la nombre de caractères total nct
ncc = nct - Len(Split(fi, "\")(UBound(Split(fi, "\")))) 'définit le nombre de caractère du chemin ncc
ch = Left(fi, ncc) 'définit le chemin d'accès du fichier fi
Set sf = CreateObject("Scripting.FileSystemObject") 'définit le système de fichiers sf (accès aux fichiers)
Set d = sf.GetFolder(ch) 'définit le dossier cible d
Set fs = d.Files 'définit l'ensembles des fichiers contenus dans le dossier cible
If fs.Count > 0 Then 'condition : si le nombre de fichiers contenus dans d est suppérieur à 0
    For Each f In fs 'boucle 1 : sur tous les fichiers du dossier d
        If f.Type = "Document texte" Then no = Left(f.Name, Len(f.Name) - 4) 'si le fichier a une extension .TXT, définit le nom de l'onglet no (nom du fichier sans l'extension)
        For Each o In Sheets 'boucle 2 : sur tous les onglets du classeur
            If o.Name = no Then GoTo suite 'si l'onglet no existe, va à l'étiquette "suite"
        Next o 'prochain onglet du classeur (boucle 2)
        Sheets.Add After:=Sheets(Sheets.Count) 'ajoute un nouvel onglet
        ActiveSheet.Name = no 'nomme le nouvel onglet
suite: 'étiquette
        Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
        With Sheets("Résultats") 'prend en compte l'onglet "Résultats"
            Set dest = .Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest
            dest.Value = no 'place le nom de l'onglet dans dest
            For i = 1 To 37 'boucle sur le décalage à droite de 1 à 33 colonnes
                Select Case i 'agit en fonction du décalage à droite
                    Case 1 To 11, 17, 18, 20 To 37 'décalage de 1 à 11, 17, 18, 20 à 37 colonnes
                        'place la fomule
                        dest.Offset(0, i).Formula = "=VLOOKUP(" & Chr(34) & Left(.Cells(2, i + 1).Value, 13) & Chr(34) & "," & no & "!A:F,5,False)"
                    Case 19 'décalage de 19 colonnes
                        'place la formule
                        dest.Offset(0, i).Formula = "=RIGHT(VLOOKUP(" & Chr(34) & Left(.Cells(2, i + 1).Value, 13) & Chr(34) & "," & no & "!A:F,5,False),3)"
                End Select 'fin de l'action en fonction du...
            Next i 'prochaine colonne de la boucle
        End With 'fin de la prise en compte de l'onglet "Résultats"
        Set od = Sheets(no) 'définit l'onglet de destination od
        od.Select 'sélectionne l'onglet de destination od
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & ch & f.Name, Destination:=Range("$A$1"))
            .Name = no
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 932
            .TextFileStartRow = 1
            .TextFileParseType = xlFixedWidth
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
            .TextFileFixedColumnWidths = Array(13, 4, 12, 45)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        Sheets("Résultats").Select
        Range("A3").Select
        Next f 'prochain fichier du dossier d (boucle 1)
End If 'fin de la condition
Sheets("Résultats").Select
Cells.Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Range("A1").Select
        Dim ws As Worksheet
    For Each ws In Worksheets
        Application.DisplayAlerts = False
        If ws.Name <> "Résultats" Then ws.Delete
    Next
    Application.DisplayAlerts = True
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

en tout cas, bon week-end ensoleillé qui sait ..