Multi import txt

Le
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 3
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel.C
Le #7076571
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" 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



francois.forcet
Le #7076771
Salut Lichel

Soit le Classeur1 dans Feuil1 les données recopiées

Je te propose ce code :

With Application.FileSearch
.LookIn = "C:Chemin"
.FileType = msoFileTypeAllFiles
.Execute
End With
With Application.FileSearch
For I = 1 To .FoundFiles.Count
If .FoundFiles(I) Like "*.txt" Then
Workbooks.OpenText Filename:="C:Chemin" & 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" & Range("A65535").End(xlUp).Row).EntireRow.Copy
Workbooks("Classeur1.xls").Sheets("Feuil1").Range("A65535").End(xlUp).Offse t(1,
0)
ActiveWorkbook.Close SaveChanges:úlse
End If
Next I
End With

Actualises "Chemin" du chemin de ton répertoire et "Classeur1.xls" et
"Feuil1" en fonction du nom de ton classeur et de ta feuille de
recopie

Fais des essais et dis moi !!!!
Michel B
Le #7076881
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"
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" 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







Michel B
Le #7076871
Bonjour François,

Je viens de tester , mais je ne sais ou il faut mettre le code, j'ai fais
une macro, mais elle ne produit rien ?

Merci pour l'aide
Michel

------------------
Sub Macro3()
'
' Macro3 Macro
' Macro enregistrée le 23/06/2008 par Admin
'
' Touche de raccourci du clavier: Ctrl+t
'
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" & Range("A65535").End(xlUp).Row).EntireRow.Copy
Workbooks("Classeur1.xls").Sheets("Feuil1").Range("A65535").End(xlUp).Offset(1,
0)
ActiveWorkbook.Close SaveChanges:úlse
End If
Next I
End With

End Sub

------------------

Salut Lichel

Soit le Classeur1 dans Feuil1 les données recopiées

Je te propose ce code :

With Application.FileSearch
.LookIn = "C:Chemin"
.FileType = msoFileTypeAllFiles
.Execute
End With
With Application.FileSearch
For I = 1 To .FoundFiles.Count
If .FoundFiles(I) Like "*.txt" Then
Workbooks.OpenText Filename:="C:Chemin" & 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" & Range("A65535").End(xlUp).Row).EntireRow.Copy
Workbooks("Classeur1.xls").Sheets("Feuil1").Range("A65535").End(xlUp).Offset(1,
0)
ActiveWorkbook.Close SaveChanges:úlse
End If
Next I
End With

Actualises "Chemin" du chemin de ton répertoire et "Classeur1.xls" et
"Feuil1" en fonction du nom de ton classeur et de ta feuille de
recopie

Fais des essais et dis moi !!!!
Daniel.C
Le #7077011
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" 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"
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" 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











Michel B
Le #7077251
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"
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" 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"
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" 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















Daniel.C
Le #7077341
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" 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"
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" 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"
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" 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



















francois.forcet
Le #7077331
Rebonjours Michel
Sur ce lien un classeur prêt à fonctionner


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

Attention tous tes fichiers doivent être dans le répertoire : "C:
Resnet"

Ils doivent avoir tous l'extension ".txt"

Fais des essais avec la macro traitement et dis moi !!!!
Michel B
Le #7077321
Re Daniel,

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

Encore
Merci
Michel



"Daniel.C"
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" 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"
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" 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"
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" 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























Michel B
Le #7077471
Re bonjour François,

je viens de tester, il n'y a aucun retour ?

J'ai mis les fichier sur,

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

Merci pour le coup de main
Michel



Rebonjours Michel
Sur ce lien un classeur prêt à fonctionner


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

Attention tous tes fichiers doivent être dans le répertoire : "C:
Resnet"

Ils doivent avoir tous l'extension ".txt"

Fais des essais avec la macro traitement et dis moi !!!!
Publicité
Poster une réponse
Anonyme