Discussion :

[MatthieuB_]

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 :

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
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.

[Menhir]

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

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
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.

[MatthieuB_]

Merci beaucoup !

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

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
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 :

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

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

[MatthieuB_]

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

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
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.

[Menhir]

Ç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 :

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

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.

[Menhir]

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.

En partant de ça.

Code :

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

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).