Extraire des données de fichiers txt dans un tableau Excel
Bonjour,
Je suis vraiment novice en vba et j'aurai besoin d'un gros coup d'aide.
Voila je souhaiterais récupérer des données de plusieurs fichiers txt dans un tableau excel avec vba. L'idée serait de glisser les fichier txt dans un dossier et d'avoir un bouton dans excel qui me permet de récupérer tout le temps les informations de mon tableau ci joint en pièce jointe.
Merci de votre aide.
Jacques
Bonjour bigdaddy154 ,
Tout d'abord je tiens a te remercier pour ton aide. J'ai mis le chemin de mon répertoire mais rien ne se passe. Que faire ?
Merci de ton aide
Jacques
Bonjour,
ne pas oublier le "\" à la fin du chemin du répertoire peut-être car sinon
D:\TéléchargementMonfichier.txt ne sera pas trouvé
Ce peut être une erreur due au copier coller du chemin dans l'exploreur de Windows car dans ce cas le anti slash n'est pas copié...
Pour l'avoir [Alt GR]+8
@ bientôt
LouReeD
Bonjour LouReed
Tout d'abord merci encore de ta réponse. En effet le anti slash n'était pas mis maintenant la macro s'execute mais une erreur apparait :
Sub Macro1()
Application.ScreenUpdating = False
repertoire = Range("M2")
Fichier = Dir(repertoire & "*.txt")
Do While Len(Fichier) > 0
Workbooks.OpenText Filename:=repertoire & Fichier, Origin:=28592 _
, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1)), TrailingMinusNumbers:=True
derligne_test = Workbooks("Test").Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
With ActiveWorkbook
Workbooks("Test").Sheets(1).Range("A" & derligne_test) = Range("B2")
Workbooks("Test").Sheets(1).Range("B" & derligne_test) = Range("D5")
Workbooks("Test").Sheets(1).Range("C" & derligne_test) = Range("D9") & " " & Range("E9")
Workbooks("Test").Sheets(1).Range("D" & derligne_test) = Range("C19")
Workbooks("Test").Sheets(1).Range("E" & derligne_test) = Range("C23")
Workbooks("Test").Sheets(1).Range("F" & derligne_test) = Range("C27")
End With
ActiveWorkbook.Close
Puis j'ai ce message qui apparait "L'indice n'appartient pas à la selection"
Essaye celui ci
Merci bigdaddy154 l'erreur etait bien la .
J'ai une question que veux dire : Array(1,1), Array(2,1),_Array(3,1) ? dans le code suivant :
FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1)),
Merci
A vrai dire je ne sais pas trop pour cette partie j'ai utilisé l'éditeur de macro d'excel tout ce que je peux te dire c'est que ça converti tes fichiers txt en fichier excel
Re,
Comment faire si je veux maintenant que les données dans le tableau arrives à la ligne A10 et non plus A2
Merci à tous
Re bonjour,
pour l'antislash ça m'est arrivé... alors pas de quoi en faire un plat, les erreurs font avancer et j'avance vite !!!
@ bientôt
LouReeD
Merci LouReed
Re,
Comment faire si je veux maintenant que les données dans le tableau arrives à la ligne A10 et non plus A2
Merci à tous
Re,
voilà je t'ai commenté le code.
Voir si ça fonctionne comme tu le souhaites.
Cordialement.
Trop rapide !!!
mais n'y aurait-il pas une petite erreur ?
'*************EFFACE LES DONNES DU TABLEAU*********
derlignetest = Range("A" & Rows.Count).End(xlUp).Row
If derlignetest = 1 Then derlignetest = 2
Range("A10:F" & derlignetest).ClearContents
'**************************************************ici si derligntest <10 alors on efface les entêtes du tableau...
'*************EFFACE LES DONNES DU TABLEAU*********
derlignetest = Range("A" & Rows.Count).End(xlUp).Row
If derlignetest < 10 Then derlignetest = 10
Range("A10:F" & derlignetest).ClearContents
'**************************************************ne serait-ce pas mieux ?
@ bientôt
LouReeD
Exact LouReed
J'ai une question que veux dire : Array(1,1), Array(2,1),_Array(3,1) ? dans le code suivant :
FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1)),
Merci
pour revenir là dessus, la fonction F sur Workbooks.OpenText est très claire... et dans votre cas FieldInfo n'est pas utile...
@ bientôt
LouReeD
Bonjour,
Voila je voudrais que lorsqu'il va chercher une case dans le fichier texte, si il ne trouve pas la case qu'il passe à la ligne du dessous jusqu'à ce qu'il trouve une valeur.
Exemple : en gras
'************OUVERTURE DES FICHIERS TXT ET RECUPERATION DES DONNEES***************
Fichier = Dir(repertoire & "*.txt")
Do While Len(Fichier) > 0
Workbooks.OpenText Filename:=repertoire & Fichier, Origin:=28592 _
, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1)), TrailingMinusNumbers:=True
Workbooks("TEST.xlsm").Sheets(1).Range("A" & derligne_test) = Range("B2")
Workbooks("TEST.xlsm").Sheets(1).Range("B" & derligne_test) = Range("D5") [b]et la il passe à la case D6 ( il trouve la valeur il l'affiche) il ne l'a trouve pas il continue et va en D7.
[/b]Merci,
Jacque
Comm
Bonjour remplace la ligne :
Workbooks("TEST.xlsm").Sheets(1).Range("B" & derligne_test) = Range("D5")par
ligne = 5
Do While Range("D" & ligne) = ""
ligne = ligne + 1
Loop
Workbooks("TEST.xlsm").Sheets(1).Range("B" & derligne_test) = Range("D"&ligne)Dis moi si ça fonctionne.
Cordialement.
Merci bigdaddy c'est nikel !!!