trier des données excel grâce à VBA

Version imprimable

Bonjour à tous,
je suis nouveau sur le forum,
je souhaite trier des informations contenues dans un classeur excel et les faire apparaître dans un autre classeur.
Pour cela, je pars de mon fichier de départ(un classeur contenant un certain nombre de feuilles excel), et je réalise une petite programmation sous VBA.
Jusqu'ici, ma réflexion 'intense' m'a permis d'écrire le code qui créée le fichier de destination. J'ai également le code qui permet de récupérer les données sources, mais je n'arrive pas à faire le lien entre les deux, et notamment parce que je n'arrive pas à bien définir ce qu'est la feuille active : vba réécrit les données dans la feuille de départ.
Quelqu'un peut-il m'aider? Voici le code que j'ai écrit :

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
Sub tridesresultats()
 
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
Dim matactive As String
Dim resultat As String
Dim unite As String
Dim dat As String
Dim numbon As String
Dim essai As Worksheet
Dim essai2 As Worksheet
 
'code qui crée un nouveau classeur et des nouvelles feuilles dedans
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add
oBook.Worksheets.Add
oBook.Worksheets.Add
oBook.Worksheets.Add
oBook.Worksheets.Add
 
'code pour la première feuille du classeur final
ActiveWorkbook.Sheets("Artichaut").Select
compteur = 0
Set oSheet = oBook.Worksheets(1)
oSheet.Name = "Artic"
oSheet.Range("A1").Value = "Matière active"
oSheet.Range("B1").Value = "Résultat"
oSheet.Range("A1:F1").Font.Bold = True
oSheet.Range("C1").Value = "Unité"
oSheet.Range("D1").Value = "Date"
oSheet.Range("E1").Value = "N° de bon"
For i = 2 To 10000
Cells(i, 6).Select
If ActiveCell.Value = "< LQ" Then
ElseIf ActiveCell.Value = "" Then
ElseIf ActiveCell.Value = "0" Then
MsgBox ("résultat nul")
Else: compteur = compteur + 1
resultat = ActiveCell.Value
unite = ActiveCell.Offset(0, 1).Value
matactive = ActiveCell.Offset(0, -2).Value
dat = ActiveCell.Offset(0, -1).Value
numbon = ActiveCell.Offset(0, -4).Value
Activebook = book516
If ActiveSheet.[A2] = "" Then
ActiveSheet.[A2].Select
Else
ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Select
End If
With ActiveCell
.Value = matactive
.Offset(0, 1).Value = resultat
.Offset(0, 2).Value = unite
End With
End If
Next i
MsgBox ("Le nombre total de détections sur ce produit est de " & compteur)
Set oSheet = oBook.Worksheets(2)
oSheet.Range("A1").Value = "Matière active"
oSheet.Range("B1").Value = "Résultat"
oSheet.Range("A1:F1").Font.Bold = True
oSheet.Range("C1").Value = "Unité"
oSheet.Range("D1").Value = "Date"
oSheet.Range("E1").Value = "N° de bon"
oSheet.Name = "Chou-Fleur"
 
Set oSheet = oBook.Worksheets(3)
oSheet.Range("A1").Value = "Matière active"
oSheet.Range("B1").Value = "Résultat"
oSheet.Range("A1:F1").Font.Bold = True
oSheet.Range("C1").Value = "Unité"
oSheet.Range("D1").Value = "Date"
oSheet.Range("E1").Value = "N° de bon"
oSheet.Name = "Brocoli"
 
Set oSheet = oBook.Worksheets(4)
oSheet.Range("A1").Value = "Matière active"
oSheet.Range("B1").Value = "Résultat"
oSheet.Range("A1:F1").Font.Bold = True
oSheet.Range("C1").Value = "Unité"
oSheet.Range("D1").Value = "Date"
oSheet.Range("E1").Value = "N° de bon"
oSheet.Name = "Carotte"
 
Set oSheet = oBook.Worksheets(5)
oSheet.Range("A1").Value = "Matière active"
oSheet.Range("B1").Value = "Résultat"
oSheet.Range("A1:F1").Font.Bold = True
oSheet.Range("C1").Value = "Unité"
oSheet.Range("D1").Value = "Date"
oSheet.Range("E1").Value = "N° de bon"
oSheet.Name = "Tomate"
 
Set oSheet = oBook.Worksheets(6)
oSheet.Range("A1").Value = "Matière active"
oSheet.Range("B1").Value = "Résultat"
oSheet.Range("A1:F1").Font.Bold = True
oSheet.Range("C1").Value = "Unité"
oSheet.Range("D1").Value = "Date"
oSheet.Range("E1").Value = "N° de bon"
oSheet.Name = "Haricot"
 
'Save the Workbook and Quit Excel
oBook.SaveAs "C:\Book516.xls "
oExcel.Quit
 
End Sub

Je vous serai très reconnaissant !!!

Merci, bonne soirée

Fred

bonjour,

et bienvenue sur le forum

un conseil pour commencer, essaye de developper des petites procedures pour chaque fonction essentiel (trier les valeurs,transferer ces données, etc).

Cela t eviteras d avoir de trop longue procédure qui seront difficile a debuguer.

Ensuite n hesite pas a utiliser l enregistreur de macro

Pour la suite , consultes les tutos de ce forum et une petite dose de courage

pour affecter la valeur d une cellule ds une cellule d une autre feuil
Code:

1 2 3 4 5 6 7 8 9 10 11 12 sub trans () dim fl1 as worksheet 'declaration d un objet feuil dim fl2 as worksheet dim i as integer set fl1 = worksheets("le_nom_de_la_feuille_1") set fl2 = worksheets("le_nom_de_la_feuille_2") 'pour affecter les dix premieres lignes de la colonne 1 for i = 1 to 10 fl2.cells(i,1).value=fl1.cells(i,1).value next i end sub

08/01/2008, 19h00
javelot69

Bonjour,

Citation:

... et notamment parce que je n'arrive pas à bien définir ce qu'est la feuille active : vba réécrit les données dans la feuille de départ.

Sauf erreur de ma part, la feuille active est celle qui est sélectionnée : tu peux modifier cette sélection ; par exemple si tu es sur la feuille 1 tu peux changer de feuille avec

Code:

Sheets("Feuil3").Select

Si VB réécrit les données dans la feuille de départ c'est que tu n'a pas sélectionné une autre feuille avant de coller ce que tu as copié.

En espérant que cela t'aidera.

Bonjour,

merci pour vos réponses.
J'ai un petit peu restructuré mon code, et j'ai un nouveau problème : j'arrive à récupérer les données, mais lorsque je veux les réécrire dans la feuille destination, les données s'effacent (la première ligne est bonne puis la seconde est effacée par la suivante, si bien qu'au final seulement deux lignes s'inscrivent).

Je pense avoir un soucis dans mon itération mais malgré mes recherches je n'arrive pas à trouver une solution.

Quelqu'un peut-il m'aider?

Voici le code :

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Sub tri()
Dim fl1 As Worksheet 'declaration d un objet feuil
Dim fl2 As Worksheet
Dim fl3 As Worksheet
Dim fl4 As Worksheet
Dim i As Integer
Dim matactive As String
Dim dat As String
Dim resultat As String
Dim numbon As String
Dim unite As String
 
ActiveWorkbook.Worksheets.Add
ActiveWorkbook.Worksheets.Add
ActiveWorkbook.Worksheets.Add
 
Set fl1 = ActiveWorkbook.Worksheets(1)
fl1.Name = ("artichauttrie")
 
Set fl2 = ActiveWorkbook.Worksheets(2)
fl2.Name = ("choufleurtrie")
 
Set fl3 = ActiveWorkbook.Worksheets(3)
fl3.Name = ("tomatetrie")
 
'récupération des données
compteur = 0
For i = 2 To 2095
ActiveWorkbook.Sheets("artichaut").Select
Cells(i, 6).Select
If ActiveCell.Value = "< LQ" Then
' ne pas écrire de commandes (concerne toutes les analyses n'ayant pas de donné de résultats)
ElseIf ActiveCell.Value = "" Then
' ne pas écrire de commandes (toutes les cases non remplies sont concernées)
Else:
' c'est ici qu'il faut remplir les commandes et récupérer toutes les données
compteur = compteur + 1
matactive = ActiveCell.Offset(0, -2).Value
dat = ActiveCell.Offset(0, -1).Value
unite = ActiveCell.Offset(0, 1).Value
numbon = ActiveCell.Offset(0, -4).Value
resultat = ActiveCell.Offset(0, 0).Value
 
        Sheets("artichauttrie").Select
        If ActiveSheet.[A2] = "" Then
        ActiveSheet.[A2].Select
        With ActiveCell
        ActiveCell.Value = matactive
        ActiveCell.Offset(0, 1).Value = resultat
        ActiveCell.Offset(0, 2).Value = unite
        ActiveCell.Offset(0, 3).Value = dat
        ActiveCell.Offset(0, 4).Value = numbon
        End With
        Else
        Range("A1").End(xlDown).Offset(1, 0).Select
        With ActiveCell
        ActiveCell.Value = matactive
        ActiveCell.Offset(0, 1).Value = resultat
        ActiveCell.Offset(0, 2).Value = unite
        ActiveCell.Offset(0, 3).Value = dat
        ActiveCell.Offset(0, 4).Value = numbon
        End With
        End If
 
End If
Next i
End Sub

Bonne journée,

Fred

Un début de piste pour t'aider à comprendre comment fonctionnent les objets:
Au lieu de

Code:

1
2
3
4
5
6
7
8
9
10
11
12
ActiveWorkbook.Worksheets.Add
ActiveWorkbook.Worksheets.Add
ActiveWorkbook.Worksheets.Add
 
Set fl1 = ActiveWorkbook.Worksheets(1)
fl1.Name = ("artichauttrie")
 
Set fl2 = ActiveWorkbook.Worksheets(2)
fl2.Name = ("choufleurtrie")
 
Set fl3 = ActiveWorkbook.Worksheets(3)
fl3.Name = ("tomatetrie")

il est plus judicieux d'écrire

Code:

1
2
3
4
5
6
7
8
Set fl1 = ActiveWorkbook.Worksheets.Add
fl1.Name = ("artichauttrie")
 
Set fl2 = ActiveWorkbook.Worksheets.Add
fl2.Name = ("choufleurtrie")
 
Set fl3 = ActiveWorkbook.Worksheets.Add
fl3.Name = ("tomatetrie")

Par la suite, utilise tes objets fl1, fl2 et fl3 lorsque tu en as besoin.
Ainsi, par exemple, au lieu de

Code:

1
2
3
ActiveWorkbook.Sheets("artichaut").Select
Cells(i, 6).Select
If ActiveCell.Value = "< LQ" Then

inspire-toi de

Code:

1
2
3
Set fl4 = ActiveWorkbook.Sheets("artichaut")
 
If fl4.Cells(i, 6).Value = "< LQ" Then

SAlut
Pour ma part voila comment je modifierais ta macro

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Sub tri()
Dim fl1 As Worksheet 'declaration d un objet feuil
Dim fl2 As Worksheet
Dim fl3 As Worksheet
Dim fl4 As Worksheet
Dim MaCellule As Range
Dim i As Integer
'Dim matactive As String
'Dim dat As String
'Dim resultat As String
'Dim numbon As String
'Dim unite As String
 
ActiveWorkbook.Worksheets.Add
ActiveWorkbook.Worksheets.Add
ActiveWorkbook.Worksheets.Add
 
Set fl1 = ActiveWorkbook.Worksheets(1)
fl1.Name = ("artichauttrie")
 
Set fl2 = ActiveWorkbook.Worksheets(2)
fl2.Name = ("choufleurtrie")
 
Set fl3 = ActiveWorkbook.Worksheets(3)
fl3.Name = ("tomatetrie")
 
'récupération des données
compteur = 0
For i = 2 To 2095
    'ActiveWorkbook.Sheets("artichaut").Select
    'Cells(i, 6).Select
    'If ActiveCell.Value = "< LQ" Then
    '    ' ne pas écrire de commandes (concerne toutes les analyses n'ayant pas de donné de résultats)
    'ElseIf ActiveCell.Value = "" Then
    '    ' ne pas écrire de commandes (toutes les cases non remplies sont concernées)
    'Else:
    '    ' c'est ici qu'il faut remplir les commandes et récupérer toutes les données
 
    With ActiveWorkbook.Sheets("artichaut").Cells(i, 6)
        If (.Value <> "< LQ") And (.Value <> "") Then
 
            compteur = compteur + 1
            'matactive = .Offset(0, -2).Value
            'dat = .Offset(0, -1).Value
            'unite = .Offset(0, 1).Value
            'numbon = .Offset(0, -4).Value
            'resultat = .Value
 
            'Sheets("artichauttrie").Select '-> fl1
            If fl1.Range("A2") = "" Then
                'ActiveSheet.[A2].Select
                'With ActiveCell
                Set MaCellule = fl1.Range("A2")
                MaCellule.Value = .Offset(0, -2).Value
                MaCellule.Offset(0, 1).Value = .Value
                MaCellule.Offset(0, 2).Value = .Offset(0, 1).Value
                MaCellule.Offset(0, 3).Value = .Offset(0, -1).Value
                MaCellule.Offset(0, 4).Value = .Offset(0, -4).Value
                'End With
            Else
 
                Set MaCellule = Range("A1").End(xlDown).Offset(1, 0)
                MaCellule.Value = .Offset(0, -2).Value
                MaCellule.Offset(0, 1).Value = .Value
                MaCellule.Offset(0, 2).Value = .Offset(0, 1).Value
                MaCellule.Offset(0, 3).Value = .Offset(0, -1).Value
                MaCellule.Offset(0, 4).Value = .Offset(0, -4).Value
            End If
 
        End If
    End With
 
Next i
End Sub

En vrac voila quelques remarques qui je l'espere te serviront:

*)Inutile de selectionner un onglet ou une cellule pour ensuite y faire reference avec ActiveCel/Sheet autant mettre en place un Bloc With (ou faire un Set) directement avec la cellule/Sheet en reference

*)Inutile de faire toute une arborecence de If, ElseIf, Else pour finir par n'utiliser que le Else, autant definir ce que tu veux ou ne veux pas et definir ta condition en utilisant des separateur And, Or, Not ....

*)Plutot que de memoriser les valeurs des cellules que tu veux transvaser dans d'autres, crer un bloc With ou une reference Set, cela alege grandement le code.

J'ai essayer dans le code de te fournir un panel de solution en vu des remarques que je t'ais faites. Je ne me suis pas penché sur le fond de ta macro juste sur la forme, j'espere donc ne pas en avoir modifié le fonctionnement (je ne pense pas).

Voila passe une bonne soirée
A++
Qwaz