[RESOLU] Fusionner plusieurs fichiers TXT sur la même feuille du même classeur

_Arnaud

XLDnaute Nouveau
Bonjour à tous!

Je suis tout neuf dans la communauté, alors merci par avance pour votre indulgence. Voici mon problème :
n fichiers texte à espacement fixe dans un répertoire. Je souhaite les avoir tous sur la même feuille. J'ai farfouillé à droite à gauche, utilisé la fonction rechercher du forum, utilisé le subterfuge de l’enregistrement de la macro VBA mais voilà, je suis à court.

Voici mon script :
Code:
Sub FUSIONPOWA()

Dim MesFichiers(2) As String, Contenu(2) As String, i As Integer, FF As Integer
MesFichiers(0) = "\\serveur\dossier\fichier99.txt"
MesFichiers(1) = "\\serveur\dossier\fichier100.txt"
MesFichiers(2) = "\\serveur\dossier\fichier101.txt"
FF = FreeFile

For i = 0 To 2
    Workbooks.OpenText Filename:= _
        MesFichiers(i), Origin _
        :=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array _
        (0, 2), Array(3, 2), Array(5, 2), Array(9, 2), Array(16, 2), Array(23, 2), Array(179, 1), _
        Array(195, 1), Array(212, 1), Array(239, 1), Array(256, 1), Array(272, 1)), _
        TrailingMinusNumbers:=True
Next i

Erase MesFichiers, Contenu
End Sub

Cette macro m'ouvre autant de fichiers xls que de fichiers txt... :cry:

Merci par avance !
 
Dernière édition:
G

Guest

Guest
Re : Fusionner plusieurs fichiers TXT sur la même feuille du même classeur

Bonjour,

Dans la macro changer "FeuilleDestination" pour le nom de la feuille destination des contenus.

Pour aller au plus simple:
Code:
Sub FUSIONPOWA()
Dim MesFichiers(2) As String, Contenu(2) As String, i As Integer, FF As Integer
MesFichiers(0) = "[URL="file://\\serveur\dossier\fichier99.txt"]\\serveur\dossier\fichier99.txt[/URL]"
MesFichiers(1) = "[URL="file://\\serveur\dossier\fichier100.txt"]\\serveur\dossier\fichier100.txt[/URL]"
MesFichiers(2) = "[URL="file://\\serveur\dossier\fichier101.txt"]\\serveur\dossier\fichier101.txt[/URL]"
For i = 0 To 2
    Workbooks.OpenText Filename:= _
        MesFichiers(i), Origin _
        :=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array _
        (0, 2), Array(3, 2), Array(5, 2), Array(9, 2), Array(16, 2), Array(23, 2), Array(179, 1), _
        Array(195, 1), Array(212, 1), Array(239, 1), Array(256, 1), Array(272, 1)), _
        TrailingMinusNumbers:=True
    'Copier la plage des cellules pour les coller dans ce classeur
    ActiveWorkbook.Sheets(1).UsedRange.Copy Destination:=ThisWorkbook.Sheets("FeuilleDestination").Range("A" & Application.Rows.Count).End(xlUp)(2)
    'Fermer le classeur sans enregistrer les changements
    ActiveWorkbook.Close False
Next i
Erase MesFichiers
End Sub

A+
 

Discussions similaires

Statistiques des forums

Discussions
312 080
Messages
2 085 144
Membres
102 793
dernier inscrit
volfy