Bonjour à tous,

Débutante en VBA je me débrouille généralement en copiant et modifiant des codes. Mais là impossible de me débloquer...

J'utilise 3 onglets pour extraire toutes mes données et rajouter des informations supplémentaires dans diverses colonnes.

J'ai crée un code où je demande de m'extraire certaines colonnes au fur et à mesure que des données sont ajoutées dans les 3 onglets (pour info, ce sont des kpi que je mets à jour chaque semaine), une fois les données extraites elles sont copiées dans un certain ordre dans mon onglet Bilan.

C'est là que ca devient complexe, j'ai des lignes qui sont très similaires à une donnée ou deux près. Donc je demande à mon code, si sur ma ligne toutes mes colonnes copiées de bilan sont pareil que dans un de mes autres onglets ne fais pas de doublon sinon...

J'arrive à faire fonctionner ca pour mon onglet relance VS bian mais les deux autres impossible... Pouvez-vous m'aider ?

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
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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
 Sub ExtraireDonneesBilan()
 
    Dim feuilleBilan As Worksheet
    Dim feuilleReparations As Worksheet
    Dim feuilleRelance As Worksheet
    Dim feuilleRMA As Worksheet
    Dim derniereLigne As Long
    Dim destLigne As Long
    Dim valeurExiste As Boolean
    Dim dictOccurrences As Object
 
    Set dictOccurrences = CreateObject("Scripting.Dictionary")
 
    ' Spécifiez les noms des feuilles de calcul
    Set feuilleBilan = ThisWorkbook.Sheets("Bilan")
    Set feuilleReparations = ThisWorkbook.Sheets("Réparations")
    Set feuilleRelance = ThisWorkbook.Sheets("Relance Interne")
    Set feuilleRMA = ThisWorkbook.Sheets("RMA")
 
    ' Trouver la dernière ligne non vide dans la colonne E de l'onglet "Bilan"
    derniereLigne = feuilleBilan.Cells(feuilleBilan.Rows.Count, "E").End(xlUp).Row + 1
 
    ' Initialisation de la ligne de destination
    destLigne = derniereLigne
 
    ' Copie des données de l'onglet "Réparations"
    For i = 2 To feuilleReparations.Cells(feuilleReparations.Rows.Count, 1).End(xlUp).Row
        valeurExiste = False
 
        For j = 2 To derniereLigne - 1
            If feuilleBilan.Cells(j, "G").Value = feuilleReparations.Cells(i, "F").Value And feuilleBilan.Cells(j, "D").Value = feuilleReparations.Cells(i, "H").Value And feuilleBilan.Cells(j, "E").Value = feuilleReparations.Cells(i, "O").Value And feuilleBilan.Cells(j, "F").Value = feuilleReparations.Cells(i, "E").Value And feuilleBilan.Cells(j, "I").Value = feuilleReparations.Cells(i, "W").Value And feuilleBilan.Cells(j, "J").Value = feuilleReparations.Cells(i, "A").Value And feuilleBilan.Cells(j, "K").Value = feuilleReparations.Cells(i, "I").Value And feuilleBilan.Cells(j, "L").Value = feuilleReparations.Cells(i, "Z").Value And feuilleBilan.Cells(j, "O").Value = feuilleReparations.Cells(i, "Q").Value And feuilleBilan.Cells(j, "P").Value = feuilleReparations.Cells(i, "R").Value Then
                valeurExiste = True
                Exit For
            End If
        Next j
 
        If Not valeurExiste Then
        ' Copiez les colonnes A, E, H, Q, R, O, W et Z de l'onglet "Réparations" dans l'onglet "Bilan"
            feuilleBilan.Cells(destLigne, "J").Value = feuilleReparations.Cells(i, "A").Value
            feuilleBilan.Cells(destLigne, "F").Value = feuilleReparations.Cells(i, "E").Value
            feuilleBilan.Cells(destLigne, "G").Value = feuilleReparations.Cells(i, "F").Value
            feuilleBilan.Cells(destLigne, "D").Value = feuilleReparations.Cells(i, "H").Value
            feuilleBilan.Cells(destLigne, "O").Value = feuilleReparations.Cells(i, "Q").Value
            feuilleBilan.Cells(destLigne, "P").Value = feuilleReparations.Cells(i, "R").Value
            feuilleBilan.Cells(destLigne, "E").Value = feuilleReparations.Cells(i, "O").Value
            feuilleBilan.Cells(destLigne, "I").Value = feuilleReparations.Cells(i, "W").Value
            feuilleBilan.Cells(destLigne, "L").Value = feuilleReparations.Cells(i, "Z").Value
            feuilleBilan.Cells(destLigne, "K").Value = feuilleReparations.Cells(i, "I").Value
            feuilleBilan.Cells(destLigne, "Q").Value = "Réparations"
 
            derniereLigne = derniereLigne + 1
            destLigne = destLigne + 1
        End If
    Next i
 
    ' Copie des données de l'onglet "Relance"
    For i = 2 To feuilleRelance.Cells(feuilleRelance.Rows.Count, 1).End(xlUp).Row
        valeurExiste = False
        For j = 2 To derniereLigne - 1
            If feuilleBilan.Cells(j, "C").Value = feuilleRelance.Cells(i, "A").Value Then
                valeurExiste = True
                Exit For
            End If
        Next j
 
        If Not valeurExiste Then
        ' Copiez les colonnes A, B, C, E, I, M et T de l'onglet "Relance" dans l'onglet "Bilan"
            feuilleBilan.Cells(destLigne, "C").Value = feuilleRelance.Cells(i, "A").Value
            feuilleBilan.Cells(destLigne, "H").Value = feuilleRelance.Cells(i, "B").Value
            feuilleBilan.Cells(destLigne, "F").Value = feuilleRelance.Cells(i, "C").Value
            feuilleBilan.Cells(destLigne, "G").Value = feuilleRelance.Cells(i, "D").Value
            feuilleBilan.Cells(destLigne, "E").Value = feuilleRelance.Cells(i, "E").Value
            feuilleBilan.Cells(destLigne, "J").Value = feuilleRelance.Cells(i, "I").Value
            feuilleBilan.Cells(destLigne, "L").Value = feuilleRelance.Cells(i, "M").Value
            feuilleBilan.Cells(destLigne, "I").Value = feuilleRelance.Cells(i, "T").Value
            feuilleBilan.Cells(destLigne, "D").Value = feuilleRelance.Cells(i, "U").Value
            feuilleBilan.Cells(destLigne, "K").Value = feuilleRelance.Cells(i, "H").Value
            feuilleBilan.Cells(destLigne, "Q").Value = "Relance"
 
            derniereLigne = derniereLigne + 1
            destLigne = destLigne + 1
        End If
    Next i
 
    ' Copie des données de l'onglet "RMA"
    For i = 2 To feuilleRMA.Cells(feuilleRMA.Rows.Count, 1).End(xlUp).Row
        valeurExiste = False
 
        For j = 2 To derniereLigne - 1
            If feuilleBilan.Cells(j, "C").Value = feuilleRMA.Cells(i, "A").Value And feuilleBilan.Cells(j, "E").Value = feuilleRMA.Cells(i, "C").Value And feuilleBilan.Cells(j, "F").Value = feuilleRMA.Cells(i, "D").Value And feuilleBilan.Cells(j, "H").Value = feuilleRMA.Cells(i, "F").Value And feuilleBilan.Cells(j, "I").Value = feuilleRMA.Cells(i, "G").Value And feuilleBilan.Cells(j, "J").Value = feuilleRMA.Cells(i, "J").Value And feuilleBilan.Cells(j, "K").Value = feuilleRMA.Cells(i, "N").Value Then
                valeurExiste = True
                Exit For
            End If
        Next j
 
        If Not valeurExiste Then
        ' Copiez les colonnes A, B, C, D, E (concaténées avec "-1"), F, G, J, N, O et P de l'onglet "RMA" dans l'onglet "Bilan"
            feuilleBilan.Cells(destLigne, "C").Value = feuilleRMA.Cells(i, "A").Value
            feuilleBilan.Cells(destLigne, "D").Value = feuilleRMA.Cells(i, "B").Value
            feuilleBilan.Cells(destLigne, "E").Value = feuilleRMA.Cells(i, "C").Value
            feuilleBilan.Cells(destLigne, "F").Value = feuilleRMA.Cells(i, "D").Value & "-" & feuilleRMA.Cells(i, "E").Value & "-1"
            feuilleBilan.Cells(destLigne, "H").Value = feuilleRMA.Cells(i, "F").Value
            feuilleBilan.Cells(destLigne, "I").Value = feuilleRMA.Cells(i, "G").Value
            feuilleBilan.Cells(destLigne, "J").Value = feuilleRMA.Cells(i, "J").Value
            feuilleBilan.Cells(destLigne, "K").Value = feuilleRMA.Cells(i, "N").Value
            feuilleBilan.Cells(destLigne, "L").Value = feuilleRMA.Cells(i, "O").Value
            feuilleBilan.Cells(destLigne, "M").Value = feuilleRMA.Cells(i, "P").Value
            feuilleBilan.Cells(destLigne, "Q").Value = "RMA"
            derniereLigne = derniereLigne + 1
            destLigne = destLigne + 1
        End If
        Next i
 
    ' Réinitialiser la colonne N à zéro
        feuilleBilan.Range("N8:N" & derniereLigne - 1).Value = ""
 
    ' Mettre à jour la colonne N avec le nombre de récurrences supérieures à 2
        For i = 8 To derniereLigne - 1
        Dim numPiece As String
        numPiece = feuilleBilan.Cells(i, "E").Value
        dictOccurrences(numPiece) = dictOccurrences(numPiece) + 1
 
    ' Vérifier si le nombre d'occurrences est supérieur à 2
        If dictOccurrences(numPiece) > 2 Then
        feuilleBilan.Cells(i, "N").Value = dictOccurrences(numPiece)
        End If
        Next i
 
 
    MsgBox destLigne - 1 & " ligne(s) extraites et copiées dans l'onglet Bilan !"
 
End Sub