Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Multi import txt

26 réponses
Avatar
Michel B
Bonjour a toutes et a tous.

J'ai un repertoire contenant différent fichier txt délimité par des " ; "
( point-virgule).
Tous ont un formatage identique.
Fichier.1.txt
Fichier.2.txt
Fichier.3.txt
Fichier.4.txt
Fichier.5.txt
Etc....

il peut y avoir entre 40 et 120 fichiers

Je dois réunir l'ensemble du contenu des fichiers présent dans une seule
feuilles.

Ma question, cela est'il automatisable et si oui comment ?

D'avance
merci

Cordialement
Michel

10 réponses

1 2 3
Avatar
Daniel.C
Regarde le classeur après exécution de la macro à l'adresse :
http://cjoint.com/?gxnKDH7P23
Daniel
"Michel B" a écrit dans le message de news:
485f85a6$0$30895$
Re Daniel,

http://cjoint.com/?gxnnqvvN5d
je te l'est mis en .rar mais ce n'est pa lourd

Encore
Merci
Michel



"Daniel.C" a écrit dans le message de news:

Peux-tu mettre un fichierde test sur www.cjoint.com en effaçant les
données confidentielle ? Poste ensuite ici l'adresse générée.
Daniel
"Michel B" a écrit dans le message de news:
485f7f32$0$3634$
Re Daniel,

Je viens de d'essayer, cela progresse, j'ai le premier fichier.
Le classeur est renommer "Resnet.10" du nom du fichier et la feuille
aussi "Resnet.10".
Puis j'ai une fenêtre d'erreur, Erreur défini par l'Application ou Objet
Et enfin les deux ligne suivante en jaune ?

Je suis sous XP avec Excel 2002 ?

ActiveSheet.UsedRange.Copy _
ThisWorkbook.Sheets("Feuil1").Cells(Ligne, 1)

Encore merci
Michel


---------------------------------------------------
"Daniel.C" a écrit dans le message de news:

J'aurais dû tester ;-(
Essaie :

Sub test()
Dim Fich As String, Ligne As Long
Const Chemin As String = "e:donneesdanielmpfe"
Application.ScreenUpdating = False
Ligne = 1
Fich = Dir(Chemin & "*.txt")
Do While Fich <> ""
Workbooks.OpenText Chemin & Fich, _
DataType:=xlDelimited, semicolon:=True
ActiveSheet.UsedRange.Copy _
ThisWorkbook.Sheets("Feuil1").Cells(Ligne, 1)
ActiveWorkbook.Close
Ligne = [A1].End(xlDown).Row + 1
Fich = Dir
Loop
Application.ScreenUpdating = True
End Sub

Cordialement.
Daniel
"Michel B" a écrit dans le message de news:
485f75f6$0$7882$
Bonjour Daniel,

Je viens de tester, mais est-ce bien comme cela qu'il fallait faire ?
Beaucoup de chose défile a l'écran, mais la table est vide a l'arivée
?

Merci pour le coup de main
Michel

---------------------------
Sub Macro2()
'
' Macro2 Macro
' Macro enregistrée le 23/06/2008 par Admin
'
' Touche de raccourci du clavier: Ctrl+r
'
Dim Fich As String, Ligne As Long
Const Chemin As String = "C:Resnet"
Ligne = 1
Fich = Dir(Chemin & "*.txt")
Do While Fich <> ""
Workbooks.OpenText Chemin & Fich, _
DataType:=xlDelimited, Semicolon:=True
ActiveSheet.UsedRange.Copy _
ThisWorkbook.Sheets("Feuil1").Cells(Ligne, 1)
ActiveWorkbook.Close
Ligne = [A1].End(xlUp) + 1
Fich = Dir
Loop
End Sub
--------------------------------------------------------
"Daniel.C" a écrit dans le message de news:

Bonjour.
Essaie, en changeant le dossier :

Sub test()
Dim Fich As String, Ligne As Long
Const Chemin As String = "e:donneesdanielmpfe"
Ligne = 1
Fich = Dir(Chemin & "*.txt")
Do While Fich <> ""
Workbooks.OpenText Chemin & Fich, _
DataType:=xlDelimited, semicolon:=True
ActiveSheet.UsedRange.Copy _
ThisWorkbook.Sheets("Feuil1").Cells(Ligne, 1)
ActiveWorkbook.Close
Ligne = [A1].End(xlUp) + 1
Fich = Dir
Loop
End Sub

Cordialement.
Daniel
"Michel B" a écrit dans le message de news:
485f658e$0$20717$
Bonjour a toutes et a tous.

J'ai un repertoire contenant différent fichier txt délimité par des
" ; " ( point-virgule).
Tous ont un formatage identique.
Fichier.1.txt
Fichier.2.txt
Fichier.3.txt
Fichier.4.txt
Fichier.5.txt
Etc....

il peut y avoir entre 40 et 120 fichiers

Je dois réunir l'ensemble du contenu des fichiers présent dans une
seule feuilles.

Ma question, cela est'il automatisable et si oui comment ?

D'avance
merci

Cordialement
Michel



























Avatar
francois.forcet
Rebonjours Michel

Je suis surpris que pour toi mon classeur ne fonctionne pas
Aprés avoir créé un répertoire "Resnet" sous C et inclus 2 fichiers
texte la macro de ce classeur recopie bien dans sa feuille l'un en
dessous de l'autre les données de ces fichiers
Surprenant que tu n'obtiennes pas le même résultat !!!!
Je ne peux utiliser ton fichier n'ayant pas le programme pour ouvrir
les .rar
Peux tu me le transmettre en .Zip ainsi que quelques fichier texte

Merci d'avance
Avatar
Michel B
Re bonjour

Voici en zip
http://cjoint.com/?gxoA4RHbVD

je ne sais ce qui ce passe, car Daniel m'as envoyé lui aussi une macro qui
fonctionne chez lui mais pas chez moi.
J'ai XP et Excel 2002.
Faut il des bibliothéque suplémentaire ?

encore merci
Michel

a écrit dans le message de news:

Rebonjours Michel

Je suis surpris que pour toi mon classeur ne fonctionne pas
Aprés avoir créé un répertoire "Resnet" sous C et inclus 2 fichiers
texte la macro de ce classeur recopie bien dans sa feuille l'un en
dessous de l'autre les données de ces fichiers
Surprenant que tu n'obtiennes pas le même résultat !!!!
Je ne peux utiliser ton fichier n'ayant pas le programme pour ouvrir
les .rar
Peux tu me le transmettre en .Zip ainsi que quelques fichier texte

Merci d'avance
Avatar
Michel B
Re bonjour Daniel,

effectivement tu obtiens le bon résultat.
Mais ici rien a faire, même message et effet.
Peut être faut il des bibliothéques suplementaires, je ne connait pas bien
VBA.
Je vais essayer sur une autre machine et je te tiens au courant

Encore merci
Michel




"Daniel.C" a écrit dans le message de news:

Regarde le classeur après exécution de la macro à l'adresse :
http://cjoint.com/?gxnKDH7P23
Daniel
"Michel B" a écrit dans le message de news:
485f85a6$0$30895$
Re Daniel,

http://cjoint.com/?gxnnqvvN5d
je te l'est mis en .rar mais ce n'est pa lourd

Encore
Merci
Michel



"Daniel.C" a écrit dans le message de news:

Peux-tu mettre un fichierde test sur www.cjoint.com en effaçant les
données confidentielle ? Poste ensuite ici l'adresse générée.
Daniel
"Michel B" a écrit dans le message de news:
485f7f32$0$3634$
Re Daniel,

Je viens de d'essayer, cela progresse, j'ai le premier fichier.
Le classeur est renommer "Resnet.10" du nom du fichier et la feuille
aussi "Resnet.10".
Puis j'ai une fenêtre d'erreur, Erreur défini par l'Application ou
Objet
Et enfin les deux ligne suivante en jaune ?

Je suis sous XP avec Excel 2002 ?

ActiveSheet.UsedRange.Copy _
ThisWorkbook.Sheets("Feuil1").Cells(Ligne, 1)

Encore merci
Michel


---------------------------------------------------
"Daniel.C" a écrit dans le message de news:

J'aurais dû tester ;-(
Essaie :

Sub test()
Dim Fich As String, Ligne As Long
Const Chemin As String = "e:donneesdanielmpfe"
Application.ScreenUpdating = False
Ligne = 1
Fich = Dir(Chemin & "*.txt")
Do While Fich <> ""
Workbooks.OpenText Chemin & Fich, _
DataType:=xlDelimited, semicolon:=True
ActiveSheet.UsedRange.Copy _
ThisWorkbook.Sheets("Feuil1").Cells(Ligne, 1)
ActiveWorkbook.Close
Ligne = [A1].End(xlDown).Row + 1
Fich = Dir
Loop
Application.ScreenUpdating = True
End Sub

Cordialement.
Daniel
"Michel B" a écrit dans le message de news:
485f75f6$0$7882$
Bonjour Daniel,

Je viens de tester, mais est-ce bien comme cela qu'il fallait faire ?
Beaucoup de chose défile a l'écran, mais la table est vide a l'arivée
?

Merci pour le coup de main
Michel

---------------------------
Sub Macro2()
'
' Macro2 Macro
' Macro enregistrée le 23/06/2008 par Admin
'
' Touche de raccourci du clavier: Ctrl+r
'
Dim Fich As String, Ligne As Long
Const Chemin As String = "C:Resnet"
Ligne = 1
Fich = Dir(Chemin & "*.txt")
Do While Fich <> ""
Workbooks.OpenText Chemin & Fich, _
DataType:=xlDelimited, Semicolon:=True
ActiveSheet.UsedRange.Copy _
ThisWorkbook.Sheets("Feuil1").Cells(Ligne, 1)
ActiveWorkbook.Close
Ligne = [A1].End(xlUp) + 1
Fich = Dir
Loop
End Sub
--------------------------------------------------------
"Daniel.C" a écrit dans le message de news:

Bonjour.
Essaie, en changeant le dossier :

Sub test()
Dim Fich As String, Ligne As Long
Const Chemin As String = "e:donneesdanielmpfe"
Ligne = 1
Fich = Dir(Chemin & "*.txt")
Do While Fich <> ""
Workbooks.OpenText Chemin & Fich, _
DataType:=xlDelimited, semicolon:=True
ActiveSheet.UsedRange.Copy _
ThisWorkbook.Sheets("Feuil1").Cells(Ligne, 1)
ActiveWorkbook.Close
Ligne = [A1].End(xlUp) + 1
Fich = Dir
Loop
End Sub

Cordialement.
Daniel
"Michel B" a écrit dans le message de
news: 485f658e$0$20717$
Bonjour a toutes et a tous.

J'ai un repertoire contenant différent fichier txt délimité par des
" ; " ( point-virgule).
Tous ont un formatage identique.
Fichier.1.txt
Fichier.2.txt
Fichier.3.txt
Fichier.4.txt
Fichier.5.txt
Etc....

il peut y avoir entre 40 et 120 fichiers

Je dois réunir l'ensemble du contenu des fichiers présent dans une
seule feuilles.

Ma question, cela est'il automatisable et si oui comment ?

D'avance
merci

Cordialement
Michel































Avatar
Daniel.C
> Peut être faut il des bibliothéques suplementaires, je ne connait pas bien
VBA.



Normalement non. Est-ce que tu as bien changé la constante "Chemin" avec un
"" à la fin ?
Daniel
Avatar
Michel B
Oui, je l'ai changer en

"C:Resnet" et j'avais au préalable esssayé ausi en reconstituant ton
chemin sur mon disk E.

J'ai essayé chez mon fils, cela ne marche pas non plus. Il est comme moi "PC
duo 3 Go"
En revanche sur le PC de ma fille cela fonctionne ?
C'est la machine la plus vieille et la moins puissante. Un AMD 2800 de 6 ans
?

Lorsque cela ne fonctionne pas ce sont toujours les deux même lignes en
jaune ?

Sur la mienne j'ai assayé en revenant a Off 2000 idem, en Off 2003 idem.
j'attend d'avoir une machine de libre pour essayer en Off 2007 ?

Je commence a désespérer
Michel


"Daniel.C" a écrit dans le message de news:

Peut être faut il des bibliothéques suplementaires, je ne connait pas
bien VBA.



Normalement non. Est-ce que tu as bien changé la constante "Chemin" avec
un "" à la fin ?
Daniel



Avatar
Daniel.C
A tout hasard, essaie le code suivant :

Sub test()
Dim Fich As String, Ligne As Long
Const Chemin As String = "e:donneesdanielmpferesnet"
Application.ScreenUpdating = False
Ligne = 1
Fich = Dir(Chemin & "*.txt")
Do While Fich <> ""
Workbooks.OpenText Chemin & Fich, _
DataType:=xlDelimited, semicolon:=True
ActiveSheet.UsedRange.Copy
ThisWorkbook.Sheets("Feuil1").Cells(Ligne, 1).PasteSpecial xlValues
ActiveWorkbook.Close
Ligne = [A1].End(xlDown).Row + 1
Fich = Dir
Loop
Application.ScreenUpdating = True
End Sub

Daniel
"Michel B" a écrit dans le message de news:
485faf23$0$29167$
Oui, je l'ai changer en

"C:Resnet" et j'avais au préalable esssayé ausi en reconstituant ton
chemin sur mon disk E.

J'ai essayé chez mon fils, cela ne marche pas non plus. Il est comme moi
"PC duo 3 Go"
En revanche sur le PC de ma fille cela fonctionne ?
C'est la machine la plus vieille et la moins puissante. Un AMD 2800 de 6
ans ?

Lorsque cela ne fonctionne pas ce sont toujours les deux même lignes en
jaune ?

Sur la mienne j'ai assayé en revenant a Off 2000 idem, en Off 2003 idem.
j'attend d'avoir une machine de libre pour essayer en Off 2007 ?

Je commence a désespérer
Michel


"Daniel.C" a écrit dans le message de news:

Peut être faut il des bibliothéques suplementaires, je ne connait pas
bien VBA.



Normalement non. Est-ce que tu as bien changé la constante "Chemin" avec
un "" à la fin ?
Daniel







Avatar
francois.forcet
Rebonjours Michel

Sur ce lien ma nouvelle proposition en droite ligne des fichiers que
tu m'as transmis :

http://www.cijoint.fr/cjlink.php?file=cj200806/cij6Fc099J.xls.

fais des essais et dis moi !!!!
Avatar
Michel B
Elle s'execute, mais bloque,

L'indice n'appartient pas à la sélection et en jaune :

Range("A1", "A" & ActiveCell.SpecialCells(xlLastCell).Row).EntireRow.Copy
Workbooks("Classeur1.xls").Sheets("Feuil1").Range(Repère)

Mais le premier fichier est pris.

Merci
Michel


-----------
Sub Traitement()
'
' Macro1 Macro
' Macro enregistrée le 23/06/2008 par FORCET
'
Sheets("Feuil1").Cells.Delete
ActiveWorkbook.Save
Repère = Range("A1").Address
With Application.FileSearch
.LookIn = "C:Resnet"
.FileType = msoFileTypeAllFiles
.Execute
End With
With Application.FileSearch
For I = 1 To .FoundFiles.Count
If .FoundFiles(I) Like "*.TXT" Then
Workbooks.OpenText Filename:="C:Resnet" & Mid(.FoundFiles(I),
Len(.LookIn) + 2), Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:úlse, Tab:úlse, Semicolon:=True,
Comma:úlse _
, Space:úlse, Other:úlse, OtherChar:=";"
Range("A1", "A" & ActiveCell.SpecialCells(xlLastCell).Row).EntireRow.Copy
Workbooks("Classeur1.xls").Sheets("Feuil1").Range(Repère)
ActiveWorkbook.Close SaveChanges:úlse
Repère = Range("A" & ActiveCell.SpecialCells(xlLastCell).Offset(1,
0).Row).Address
End If
Next I
End With


'
End Sub
---------------

a écrit dans le message de news:

Rebonjours Michel

Sur ce lien ma nouvelle proposition en droite ligne des fichiers que
tu m'as transmis :

http://www.cijoint.fr/cjlink.php?file=cj200806/cij6Fc099J.xls.

fais des essais et dis moi !!!!


Avatar
Michel B
Ca progresse encore.
maintenant j'ai toute les données.
Pendant l'exécution j'ai plusieur de message, une quinzaine (OK ou NON),
concernant le presse papier
et a l'arrivée, j'ai une quarantaine de lignes, les première qui reprenne
plusieur fois le code de la macro !

mais c'est tout de même mieux, je te joint le fichier

http://cjoint.com/?gxr1OZkWPf
Michel


"Daniel.C" a écrit dans le message de news:

A tout hasard, essaie le code suivant :

Sub test()
Dim Fich As String, Ligne As Long
Const Chemin As String = "e:donneesdanielmpferesnet"
Application.ScreenUpdating = False
Ligne = 1
Fich = Dir(Chemin & "*.txt")
Do While Fich <> ""
Workbooks.OpenText Chemin & Fich, _
DataType:=xlDelimited, semicolon:=True
ActiveSheet.UsedRange.Copy
ThisWorkbook.Sheets("Feuil1").Cells(Ligne, 1).PasteSpecial xlValues
ActiveWorkbook.Close
Ligne = [A1].End(xlDown).Row + 1
Fich = Dir
Loop
Application.ScreenUpdating = True
End Sub

Daniel
"Michel B" a écrit dans le message de news:
485faf23$0$29167$
Oui, je l'ai changer en

"C:Resnet" et j'avais au préalable esssayé ausi en reconstituant ton
chemin sur mon disk E.

J'ai essayé chez mon fils, cela ne marche pas non plus. Il est comme moi
"PC duo 3 Go"
En revanche sur le PC de ma fille cela fonctionne ?
C'est la machine la plus vieille et la moins puissante. Un AMD 2800 de 6
ans ?

Lorsque cela ne fonctionne pas ce sont toujours les deux même lignes en
jaune ?

Sur la mienne j'ai assayé en revenant a Off 2000 idem, en Off 2003 idem.
j'attend d'avoir une machine de libre pour essayer en Off 2007 ?

Je commence a désespérer
Michel


"Daniel.C" a écrit dans le message de news:

Peut être faut il des bibliothéques suplementaires, je ne connait pas
bien VBA.



Normalement non. Est-ce que tu as bien changé la constante "Chemin" avec
un "" à la fin ?
Daniel











1 2 3