Macro création écriture de fichier txt

Version imprimable

Bonjour,

Ingénieur calcul dans le bâtiment, j'utilise régulièrement des macros VBA pour réaliser des calculs itératifs et des opérations répétitives au sein d'Excel.
Mais j'ai désormais un besoin plus complexe, et après avoir regardé différents tutos, je ne comprends pas comment m'y prendre. J'aimerais donc savoir s'il est possible de faire en VBA ce que je veux faire, si oui, je me remettrai à chercher comment.

J'ai un fichier excel, courbes.xlsm
Il est situé à : C:/_Calculs/
Il contient un onglet nommé : courbes
Dans cet onglet se trouvent 208 courbes de la forme suivant : une colonne abscisse une colonne ordonnées (dans ce cas précis, de la ligne 2 à la ligne 722)
En spoiler les premières lignes de quelques courbes pour illustration :
Code:

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 s P1O0 s P1O1 s P1O2 s P1O3 s P1O4 s P1O5 ... 0 0 0 0 0 0 0 0 0 0 0 0 10 1079 10 1041 10 1229 10 1621 10 1889 10 1003 20 4105 20 4345 20 4824 20 6254 20 7106 20 3847 30 7045 30 7218 30 8277 30 10830 30 11988 30 6896 40 10177 40 9982 40 11027 40 14186 40 16883 40 11304 50 13104 50 12979 50 14750 50 18472 50 21847 50 14949 60 15908 60 16368 60 17972 60 22876 60 26684 60 18402 70 18534 70 19283 70 21812 70 28365 70 32162 70 21954 80 21487 80 22406 80 24676 80 32193 80 36495 80 25527 90 24149 90 25015 90 28070 90 36491 90 41221 90 27979 100 27110 100 27992 100 30812 100 40663 100 45244 100 31989 110 28466 110 31532 110 35357 110 48812 110 52006 110 33976 120 30124 120 34781 120 39483 120 54463 120 56218 120 33588 130 32934 130 37923 130 43371 130 60195 130 62037 130 33458 140 35623 140 41237 140 46604 140 64306 140 65329 140 39896 150 39262 150 44086 150 49697 150 68424 150 71743 150 45920 160 41093 160 47228 160 53642 160 74480 160 75472 160 39245 170 42506 170 49706 170 56790 170 78004 170 76595 170 35310 180 44107 180 52144 180 59930 180 82245 180 79126 180 39057 190 49421 190 56044 190 63158 190 84955 190 82803 190 42871 200 52957 200 59819 200 67146 200 78667 200 79112 200 44327 210 52570 210 61939 210 68390 210 83805 210 84732 210 49739 220 54704 220 64885 220 71184 220 83173 220 90106 220 56462 230 57686 230 67148 230 73573 230 81590 230 92819 230 65667 240 60636 240 70120 240 75416 240 76533 240 90310 240 85641 250 64804 250 72328 250 75391 250 84319 250 92492 250 89403 260 66651 260 74333 260 76580 260 82271 260 94364 260 100000 270 67642 270 77285 270 80088 270 89967 270 97477 270 97714 280 69943 280 78084 280 78994 280 84303 280 100000 280 100000 290 72268 290 80298 290 80858 290 95970 290 100000 290 100000 300 76037 300 81304 300 77834 300 100000 300 100000 300 100000 ...
Mon objectif serait :
- créer un fichier nommé comme la cellule B1 (ligne 1 col 2) (avec ou sans extension de fichier, peut importe)
- copier-coller dedans le contenu des cellules A2:B722 (ligne 2 col 1 à ligne 722 col 2)
- sauvegarder et fermer le fichier créé
- incrémenter de deux colonnes 207 fois pour avoir un total de 208 fichiers.

A la main c'est fastidieux, et juste relou ^^
Est-ce possible en VBA ?

Merci d'avance.

C'est plus rapide d'écrire le code que d'expliquer comment faire.
Donc :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Dim WSSource As Worksheet, WSDest As Worksheet
Dim WBSource As Workbook, WBDest As Workbook
Dim Col As Long
 
Set WSSource = ActiveSheet
Set WBSource = ActiveWorkbook
Set WBDest = Workbooks.Add
Set WSDest = ActiveSheet
 
For Col = 1 To WSSource.Cells(1, Columns.Count).End(xlToLeft).Column Step 2
    WSSource.Cells(1, Col).Resize(1, 2).EntireColumn.Copy WSDest.Range("A1")
    WBDest.SaveAs FileName:=WBSource.Path & "\" & WSSource.Cells(1, Col + 1).Value
    WSDest.Columns("A:B").ClearContents
Next Col
 
WBDest.Clos

Par contre, c'est du code tapé à l'arrache directement sur le forum et non testé. Je te laisse donc faire un éventuel débugage.

Merci beaucoup !

Une petite modification m'a permis de supprimer la première ligne de chaque fichier.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Modifiee()
'from internet
'https://www.developpez.net/forums/d1872997/logiciels/microsoft-office/excel/macros-vba-excel/macro-creation-ecriture-fichier-txt/#post10357479
 
Dim WSSource As Worksheet, WSDest As Worksheet
Dim WBSource As Workbook, WBDest As Workbook
Dim Col As Long
 
Set WSSource = ActiveSheet
Set WBSource = ActiveWorkbook
Set WBDest = Workbooks.Add
Set WSDest = ActiveSheet
 
For Col = 1 To WSSource.Cells(1, Columns.Count).End(xlToLeft).Column Step 2
    WSSource.Cells(2, Col).Resize(721, 2).Copy WSDest.Range("A1")
    WBDest.SaveAs Filename:=WBSource.Path & "\" & WSSource.Cells(1, Col + 1).Value
    WSDest.Columns("A:B").ClearContents
Next Col
 
WBDest.Clos
End Sub

Maintenant je cherche pour le mettre en format txt au lieu de xlsx, mon solveur n'arrivant pas à lire le xlsx ^^

En partant de ça.

Code:

1
2
3
 ActiveWorkbook.SaveAs Filename:="C:\_Calculs\courbes2.txt", FileFormat:= _
        xlText, CreateBackup:=False
    Windows("courbes.txt").Activate

Ça marche, tout en .txt et sans la première ligne.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Modifiee2()
'from internet : Menhir
'https://www.developpez.net/forums/d1872997/logiciels/microsoft-office/excel/macros-vba-excel/macro-creation-ecriture-fichier-txt/#post10357479
 
Dim WSSource As Worksheet, WSDest As Worksheet
Dim WBSource As Workbook, WBDest As Workbook
Dim Col As Long
 
Set WSSource = ActiveSheet
Set WBSource = ActiveWorkbook
Set WBDest = Workbooks.Add
Set WSDest = ActiveSheet
 
For Col = 1 To WSSource.Cells(1, Columns.Count).End(xlToLeft).Column Step 2
    WSSource.Cells(2, Col).Resize(721, 2).Copy WSDest.Range("A1")
    'WBDest.SaveAs Filename:=WBSource.Path & "\" & WSSource.Cells(1, Col + 1).Value
    WBDest.SaveAs Filename:=WBSource.Path & "\" & WSSource.Cells(1, Col + 1).Value & ".txt", FileFormat:= _
        xlText, CreateBackup:=False
    WSDest.Columns("A:B").ClearContents
Next Col
 
WBDest.Clos
End Sub

Merci énormément.

11/07/2018, 14h00
Menhir
Citation:

Envoyé par MatthieuB_

Maintenant je cherche pour le mettre en format txt au lieu de xlsx, mon solveur n'arrivant pas à lire le xlsx ^^

Dans ce cas, il serait bien plus simple de créer un nouvel onglet plutôt qu'un nouveau classeur puisqu'on peut appliquer SaveAs aussi à Worksheet.
Citation:
En partant de ça.

Code:

1 2 3 ActiveWorkbook.SaveAs Filename:="C:\_Calculs\courbes2.txt", FileFormat:= _ xlText, CreateBackup:=False Windows("courbes.txt").Activate
Le CreateBackup est inutile (il est à False par défaut de toute façon) et je ne vois pas non plus l'intérêt du Activate qui suit (à part ralentir l'exécution).

Citation:

Envoyé par MatthieuB_

Ça marche, tout en .txt et sans la première ligne.

Il aurait été plus propre, plus sûr et plus souple d'écrire :
Code:

1 2 3 4 5 6 For Col = 1 To WSSource.Cells(1, Columns.Count).End(xlToLeft).Column Step 2 WSSource.Cells(1, Col).Resize(1, 2).EntireColumn.Copy WSDest.Range("A1") WSDest.Rows(1).Delete WBDest.SaveAs Filename:=WBSource.Path & "\" & WSSource.Cells(1, Col + 1).Value & ".txt", FileFormat:= xlText WSDest.Columns("A:B").ClearContents Next Col
L'avantage de ce code, c'est qu'il s'adapte au changement du nombre de lignes.