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
| Sub Report_Montant()
's'il y a un montant dans la colonne G de la feuil1, le reporter suivant les consignes données
'voir feuille mémo répartition
Dim Nom_Feuille_1 As String
Dim Nom_Feuille_2 As String
Nom_Feuille_1 = "Feuil1" 'à ajuster au besoin
Nom_Feuille_2 = "Feuil2" 'à ajuster au besoin
Dim c As Range
For Each c In Sheets(Nom_Feuille_1).Range("G2:G" & Sheets(Nom_Feuille_1).Range("A" & Rows.Count).End(xlUp).Row)
If c.Value > 0 And Right(Sheets(Nom_Feuille_1).Range("B" & c.Row), 4) <> "0000" Then 'pour chaque cellule de la colonne G en Feuil1, je vérifie si montant et si code ne termine pas par 0000
'Je récup le code spécificité équivalent en B et le décompose
Dim Spécificité As String
Spécificité = Sheets(Nom_Feuille_1).Range("B" & c.Row)
Dim Racine As String
Racine = Left(Spécificité, 4)
Dim Cinq As Integer
Dim Six As Integer
Dim Sept As Integer
Dim Huit As Integer
Cinq = Right(Left(Spécificité, 5), 1)
Six = Right(Left(Spécificité, 6), 1)
Sept = Right(Left(Spécificité, 7), 1)
Huit = Right(Left(Spécificité, 8), 1)
Dim Ma_Col As String
'Cas 1 : 5=1 et 7=1 => Col. C
If Application.And(Cinq = 1, Sept = 1) Then
Ma_Col = "C"
End If
'Cas 2 : 5=1 et 7=2 => Col. D
If Application.And(Cinq = 1, Sept = 2) Then
Ma_Col = "D"
End If
'Cas 3 : 5=2 ou 4 et 6=1 et 7=1 et 8=1 => Col. G
If Application.And(Application.Or(Cinq = 2, Cinq = 4), Six = 1, Sept = 1, Huit = 1) Then
Ma_Col = "G"
End If
'Cas 4 : 5=2 ou 4 et 6=1 et 7=1 et 8= 2 ou 4 ou 8 => Col. H
If Application.And(Application.Or(Cinq = 2, Cinq = 4), Six = 1, Sept = 1, Application.Or(Huit = 2, Huit = 4, Huit = 8)) Then
Ma_Col = "H"
End If
'Cas 5 : 5=2 ou 4 et 6=1 et 7=2 => Col. i
If Application.And(Application.Or(Cinq = 2, Cinq = 4), Six = 1, Sept = 2) Then
Ma_Col = "i"
End If
'Cas 6 : 5=2 ou 4 et 6=2 et 8=1 => Col. E
If Application.And(Application.Or(Cinq = 2, Cinq = 4), Six = 2, Huit = 1) Then
Ma_Col = "E"
End If
'Cas 7 : 5=2 ou 4 et 6=2 et 8= 2 ou 4 ou 8 => Col. F
If Application.And(Application.Or(Cinq = 2, Cinq = 4), Six = 2, Application.Or(Huit = 2, Huit = 4, Huit = 8)) Then
Ma_Col = "F"
End If
'Cas 8 : 5=3 => Col. J
If Cinq = 3 Then
Ma_Col = "J"
End If
'report de l'info si la ligne existe
Dim Ligne_Equiv_Feuil2 As String
If WorksheetFunction.IfError(Application.Match(Racine, Sheets(Nom_Feuille_2).Range("A:A"), 0), "N EXISTE PAS") <> "N EXISTE PAS" Then
Ligne_Equiv_Feuil2 = Application.Match(Racine, Sheets(Nom_Feuille_2).Range("A:A"), 0) 'ca me permet d'avoir la ligne equiv en feuille 2
'j'ai déterminé la colonne et la ligne donc je reporte l'info en Feuille 2
Sheets(Nom_Feuille_2).Range(Ma_Col & Ligne_Equiv_Feuil2).Formula = "=" & Sheets(Nom_Feuille_1).Name & "!" & c.Address 'c etant la cellule testée au départ
Else
MsgBox ("Le montant de " & c.Value & " € présent en G" & c.Row & " n'a pas été reporté car le code est absent en " & Nom_Feuille_2 & " => [ " & Sheets(Nom_Feuille_1).Range("C" & c.Row).Value & " ]"), , "Report de cette info annulé"
End If
End If
Next
End Sub |
