Discussion :

[Invité]

Bonjour,

Tout d'abord, je tiens à préciser que je suis un pur novice en terme de programmation, même basique comme le VBA, mais que je me vois obligé de m'y plonger pour automatiser le traitement de données issues d'une de mes expérimentations.

Je souhaiterai donc réaliser une macro qui me permettrait de copier les deux colonnes contenues dans des fichiers ".txt" (il y en a une 100aines, d'où le soucis d'automatisation) dans un seule feuille d'un classeur excel et les unes à la suite des autres.

De plus, les fichiers ".txt" en question sont noyés dans un dossier qui en contient bien d'autres, mais ces fichiers possèdent la particularité commune de possèder "*-Corr.txt" dans leurs noms.

Enfin, pour un soucis de lisibilité, j'ai choisis de copier mes colonnes à partir de la ligne 2.

Donc voici la macro que je suis parvenu à écrire après moult recherches:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Command666_Click()
 Dim MyFolder As String
 Dim myfile As String
 Dim folderName As String
 
 With Application.FileDialog(msoFileDialogFolderPicker)
 .AllowMultiSelect = False
 If .Show = -1 Then
 
 folderName = .SelectedItems(1)
 End If
 End With
 
 myfile = Dir(folderName & "\*-Corr.txt")
 
 Do While myfile <> ""
 Workbooks.OpenText Filename:=folderName & "\" & myfile
 
 
 'crée une requête sur le fichier texte et insère les champs dans la feuille "Feuil1" en partant de "A2"
 Worksheets("Feuil1").QueryTables.Add("TEXT;" & myfile, [A2]).Refresh
 
 
 
'la suite est utilisée pour fermer mes fichiers txt
 Application.DisplayAlerts = False
 ActiveWorkbook.Close
 Application.DisplayAlerts = True
 myfile = Dir
 Loop
End Sub

J'arrive, grâce à cette macro, à ouvrir mes fichiers ".txt" de manière nominative ("*-Corr.txt") et à les fermer les uns à la suite dans autres. Seulement, je n'arrive pas à me dépatouiller de ma fonction "If", donc aucune copie ne s'effectue.

Si quelqu'un arrivait à m'éclairer sur mes erreurs, je lui serais absolument reconnaissant.

[Marc-L]

Bonjour, bonjour !

Vérifier ce que renvoie la fonction Dir dans la variable myfile !

Sinon comme la présentation laisse à désirer, joindre deux fichiers texte source et un classeur xlsx (sans macro)
contenant le résultat escompté vis à vis de ces fichiers source …

[Invité]

Désolé pour les soucis de présentation, c'est mon premier message sur ce forum. Je joins donc les fichiers que tu m'as demandé pour mieux comprendre mon problème. Il y a donc plusieurs fichiers txt dans le fichier zip et je ne voudrais importer que les colonnes de ceux dont le nom se finit par "*-Corr.txt".

Merci encore de ton attention.

[Invité]

Bon, j'ai retravaillé mon code et j'obtiens ca:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Sub CommandButtonClick()
 
 Dim MyFolder As String
 Dim myfile As String
 Dim folderName As String
 
 Dim NomMaitre As String
 Dim NomEsclave As String
 
 NomMaitre = ActiveWorkbook.Name
 
 With Application.FileDialog(msoFileDialogFolderPicker)
 .AllowMultiSelect = False
 If .Show = -1 Then
 
 folderName = .SelectedItems(1)
 End If
 End With
 
 myfile = Dir(folderName & "\*-Corr.txt")
 
 Do While myfile <> ""
 Workbooks.OpenText Filename:=folderName & "\" & myfile
 
 NomEsclave = ActiveWorkbook.Name
 Range("A1:B1000").Select
 Selection.Copy
 
 Workbooks(NomMaitre).Activate
 Range("A2").Select
 ActiveSheet.Paste
 Application.WindowState = xlMinimized
 
 Workbooks(NomEsclave).Activate
 
 'use below 3 lines if you want to close the workbook right after saving, so you dont have a lots of workbooks opened
 Application.DisplayAlerts = False
 ActiveWorkbook.Close
 Application.DisplayAlerts = True
 myfile = Dir
 Loop
 
 
End Sub

Le seul soucis réside maintenant dans la ligne "Range("A2").Select"... En effet, je copie bien l'ensemble des colonnes de mes fichiers "*-Corr.txt" dans mon classeur xlm, mais je les copie les unes SUR les autres (donc en A2:B1000)... Il faudrait donc introduire une variable, mais je n'ai pas encore trouvé la solution...

[Marc-L]

Un bon code n'utilise pas de Select et autre Activate à tout va !

Occupé, je proposerai une solution au plus tard demain s'il n'y a pas eu d'autre intervenant …

Fait-il importer les fichiers texte dans un nouveau classeur ou à la suite de la feuille 1 du classeur exécutant le code ?

[Invité]

Bon, j'ai réussi à traficoter ce code qui marche:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Function FisrtEmptyCell(Plage As Range) As Range
    Dim Rg As Range
 
    On Error Resume Next
    Set Rg = Plage.SpecialCells(xlCellTypeBlanks)
    If Rg Is Nothing Then Set FisrtEmptyCell = Plage(Plage.Cells.Count) _
                     Else Set FisrtEmptyCell = Rg(1)
    Set Rg = Nothing
End Function
 
Sub ImportFichTxtCorr()
 
 Dim MyFolder As String
 Dim myfile As String
 Dim folderName As String
 
 Dim NomMaitre As String
 Dim NomEsclave As String
 
 NomMaitre = ActiveWorkbook.Name
 
 With Application.FileDialog(msoFileDialogFolderPicker)
 .AllowMultiSelect = False
 If .Show = -1 Then
 
 folderName = .SelectedItems(1)
 End If
 End With
 
 myfile = Dir(folderName & "\*-Corr.txt")
 
 Do While myfile <> ""
 Workbooks.OpenText Filename:=folderName & "\" & myfile
 
 NomEsclave = ActiveWorkbook.Name
 Range("A1:B1000").Select
 Selection.Copy
 
 Workbooks(NomMaitre).Activate
 FisrtEmptyCell([A2:ZZ2]).Select
 ActiveSheet.Paste
 Application.WindowState = xlMinimized
 
 Workbooks(NomEsclave).Activate
 
 'use below 3 lines if you want to close the workbook right after saving, so you dont have a lots of workbooks opened
 Application.DisplayAlerts = False
 ActiveWorkbook.Close
 Application.DisplayAlerts = True
 myfile = Dir
 Loop
 
 
End Sub