Discussion :

[lapagaille]

Bonjour

je suis débutant en macro et je voudrais pouvoir lancer une macro qui permettrait de copier/coller une plage excel dans un nouveau fichier dès lors que jai un changement de valeur dans une colonne cf exemple ci-dessous :

En gros dès lors que la valeur age est différente de la suivante : D8 <> de D9; alors je copie colle toute la plage avec un age égale à 13 dans un nouveau fichier excel; et ainsi de suite pour chaque valeur âge différente (voir ci-dessous nouveau fichier 1, nouveau fichier 2,....)

	A	B	C	D	E	F	G	H	I
1	Nom	Prénom	Sexe	Age		Nouveau fichier 1			
2	Thomas	Nina	F	13		Nom	Prénom	Sexe	Age
3	Soul	Tala	M	13		Thomas	Nina	F	13
4	Debar	Steph	F	13		Soul	Tala	M	13
5	Tche	Nicolas	M	13		Debar	Steph	F	13
6	Thomas	Arnaud	M	13		Tche	Nicolas	M	13
7	Thomas	Judith	F	13		Thomas	Arnaud	M	13
8	Bievale	Fred	M	13		Thomas	Judith	F	13
9	Gong	Xian	F	14		Bievale	Fred	M	13
10	Bourry	Nadia	F	14					
11	Galano	thierry	M	14		Nouveau fichier 2			
12	Mours	Isa	F	14		Nom	Prénom	Sexe	Age
13	Foxy	Brown	F	15		Gong	Xian	F	14
14	Sina	Eliane	F	15		Bourry	Nadia	F	14
15	Jano	Carl	M	15		Galano	thierry	M	14
16	Bialek	Louis	M	15		Mours	Isa	F	14
17									
18									
19						Nouveau fichier 3			
20						Nom	Prénom	Sexe	Age
21						Foxy	Brown	F	15
22						Sina	Eliane	F	15
23						Jano	Carl	M	15
24						Bialek	Louis	M	15

Merci de votre aide.

[defluc]

Bonjour,

Un fichier joint faciliterait la compréhension.

Cordialement.

[Kimy_Ire]

Bonjour lapagaille,

Voici le code que je te propose :

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
Sub division()
Dim cell_ori As Range
Dim val As Integer
Dim nom As String
 
With Worksheets("Feuil2")
    Set cell_ori = .Range("D1")
    val = 2
 
    For i = 2 To .Columns(1).Find("*", , , , , xlPrevious).Row
        If cell_ori.Offset(i, 0) <> cell_ori.Offset(i - 1, 0) Then
            .Range("$A" & val & ":$D" & i).Copy
 
            nom = "Valeur " & cell_ori.Offset(i - 1, 0)
            create_wkb (nom)
 
            'Place le chemin où tu as sauvegardé ton fichier ici
            Workbooks.Open Filename:="C:\Users\...\Desktop\" & nom
            ActiveSheet.Paste Destination:=Worksheets(nom).Range("A2")
 
            ActiveWorkbook.Close True
 
            val = i + 1
        End If
    Next i
End With
 
End Sub
 
Sub create_wkb(str As String)
 
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
 
    Set xlApp = CreateObject("Excel.Application")
    xlApp.SheetsInNewWorkbook = 1
 
    Set xlBook = xlApp.Workbooks.Add
    'Place le chemin de sauvegarde ici
    xlBook.SaveAs ("C:\Users\...\Desktop\" & str)
    xlApp.Visible = True
 
    Set xlSheet = xlBook.Worksheets(1)
    xlSheet.Name = str
    xlSheet.Range("A1") = "Nom"
    xlSheet.Range("B1") = "Prénom"
    xlSheet.Range("C1") = "Sexe"
    xlSheet.Range("D1") = "Age"
 
    xlBook.Close True
 
End Sub

Il y a surement mieux en terme de performance mais je pense que ça devrait convenir à ta demande - en espérant avoir compris celle-ci.

N'hésite pas à me faire un retour.

Cordialement,
Kimy

Petite rectification dans ma dernière macro :
J'ai modifié cette ancienne ligne :

Code :

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

For i = 2 To .Columns(1).Find("*", , , , , xlPrevious).Row - 2

par celle-ci :

Code :

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

For i = 2 To .Columns(1).Find("*", , , , , xlPrevious).Row

Je ne prenais pas en compte la dernière itération.