Discussion :

[Richard_35]

Bonjour à tous,

Je fais appel à une bonne âme de développeur afin de créer un programme qui permettrait de créer autant de fichier Excel que de rupture sur un champ donné d'un fichier Excel de référence.

Exemple :
Soit le fichier Excel de référence toto.xls :

Code :

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

1
2
3
4
5
            A     B     C     D     E
Ligne 1    aaa   000   111   222   333
Ligne 2    aaa   444   555   666   777
Ligne 3    bbb   888   999   101   111
Ligne 4    ccc   121   131   141   151

Création d'un bouton qui génèrerait, dans le même répertoire :
1 fichier Excel nommé aaa.xls composé de :

Code :

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

1
2
3
           A     B     C     D     E
Ligne 1    aaa   000   111   222   333
Ligne 2    aaa   444   555   666   777

1 fichier Excel nommé bbb.xls composé de :

Code :

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

1
2
           A     B     C     D     E
Ligne 1    bbb   888   999   101   111

1 fichier Excel nommé ccc.xls composé de :

Code :

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

1
2
           A     B     C     D     E
Ligne 1    ccc   121   131   141   151

Merci d'avance de votre aide,
Richard.

[le_dilem]

Essaye ça

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
Sub Ruptures()
Dim i, J
Dim nom
 
nom = (ThisWorkbook.Name)
i = 1
J = 1
 
While Range("A" & i) <> ""
 
If Range("A" & i) <> Range("A" & i + 1) Then
 
Rows(J & ":" & i).Select
  Selection.Copy
  Workbooks.Add
 
    Rows(1 & ":" & 1).Select
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs Filename:="D:\" + Range("A" & 1)
 
 
   Windows(nom).Activate
    Sheets("Feuil1").Select
J = i + 1
End If
 
i = i + 1
 
Wend
End Sub

[Richard_35]

Bonjour le_dilem,

Parfait !
C'est, exactement, ce que je souhaitais.

Merci encore,
Richard.

[Richard_35]

Bonjour à tous,

Juste un petit add-on, gentiment développé par le_dilem (merci encore) qui permet de récupérer la ligne d'entête pour tous les fichiers Excel générés à chaque rupture :

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
Sub RupturesAvecEntete()
Dim i, J
Dim nom
Dim ligne1
 
nom = (ThisWorkbook.Name)
i = 2
J = 2
 
ligne1 = Rows(1 & ":" & 1)
 
While Range("A" & i) <> ""
If Range("A" & i) <> Range("A" & i + 1) Then
 
Rows(J & ":" & i).Select
  Selection.Copy
  Workbooks.Add
 
  Rows(1 & ":" & 1) = ligne1
    Rows(2 & ":" & 2).Select
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs Filename:="C:\Tests_divers\" + Range("A" & 2)
 
   Windows(nom).Activate
    Sheets("Feuil1").Select
 
J = i + 1
End If
 
i = i + 1
 
Wend
End Sub

A bientôt,
Richard.