Modification code

Bonjour

voila j'ai commencé un code et je n'arrive pas à le finir ayant pour delai lundi j'ai vraiment besoin d un gros coup de main .....

voila le but du programme :

- en faite il faut que quand je sélectione une cellule ou plusieurs avec ctrl+clik dans la page 2401 colone D (sachant que tous les jours je rajoute une page comme la page 2401 donc faudrait que dans la page suivante et x pages apres la macro marche pour chaque nouvelles pages)

- les données correspondantes a chaque cellules cliquées colonne D soient rassemblées pour chaque operation CLI REC PAY SF VD .... RATE

- et ensuite réaliser chaque ticket (=petit tableau) comme le tableau (de référence) page nommée REF pour chaque opérations cliquées

- chaque page sera nommée par le numéro correspondant du Ticket dans la cellule de la ligne i .... si je sélectione D27 et D30 , la macro devra créer un onglet nommé par le contenu de la cellule D27 avec le ticket correspondant au données de la ligne 27 page 2401 et un onglet nommé par le contenu de la cellule D30 et contenir le petit tableau avec chaque donnée de la ligne D30 page 2401

---
Concernant le tableau du ticket il faut qu'il y ait 4 decimales, pas de nombre négatif et

en ce qui concerne les noms, a côté de my eur et my usd (faut laisser la formule associant le "my" et le "their" avec la devise )
pour les céllules B14 et B15 resteront inchangées dans tous les nouveaux tickets ...

les noms en (C14; D14) et (C15;D15), les 2 dernières cellules du petit tableau ticket dc doivent remonter le nom contenu dans le grand tableau a côté,
en fonction de si c est "my eur" il ira chercher dans la ligne EBISA du grand tableau le nom de la banque dans la colone EUR (DEUTDEFF)
si c'est "my USD" il ira dans la ligne EBISA mais cherche le nom dans la colone USD (CITIUS33)
Donc pour "my+devise" il ira toujours dans la ligne EBISA cela dependra de la devise
Dans le ticket page "REF" c est DEUTDEFF car c'est "my eur" donc il va dans la ligne EBISA colone EUR

' pour "their USD" il ira cherché le nom en fonction du nom de la contrepartie (=CLI page 2401) et la devise ( exemple si ecobank benin (cellule A27 page 2401) dans le petit tableau, est la counterparty et que c est "their USD" il ira chercher ds la colone USD de la ligne ecobank benin chercher le code (CITIUS33) pour l afficher
' donc cette boucle dans mon code n'est pas bien car elle se référe juste a 2 noms alors qu'elle doit copier dans le grand tableau dans la feuille "REF"

voici la liste des charges

et le code du module

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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
 
Option Explicit ' pour obliger a déclarer toutes tes variables
 
Public i As Integer
Public Nom As String
Public MaFeuille As Worksheet
Public message As String
Public MaNewFeuille As Worksheet
 
Public Sub CréatNoms()
 
Dim débnoms As Range
Dim listnoms As Range
 
 
Set débnoms = Sheets(Sheets.Count).Range("A26")
 
Set listnoms = Range(débnoms, débnoms.End(xlToRight))
 
For Each débnoms In listnoms
    For i = 1 To 10
        ActiveWorkbook.Names.Add Name:=débnoms.Value & "_" & i, RefersToR1C1:=débnoms.Offset(i, 0)
    Next
Next
 
'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
    For i = 1 To 10
        If Selection = Range("D" & i) Then
        Selection = Range("A" & i, ActiveCell.Offset(0, 12))
        End If
    Next i
 
 
End Sub
 
 
Sub Transf_Data()
'
' Transf_Data Macro
'
'
'   Création nouvelle page avec le numèro du deal
 
Set MaFeuille = Sheets(Sheets.Count)
 
Nom = Sheets(Sheets.Count).Range("D27").Value
 
'On vérifie que le nom n'existe pas déjà
On Error Resume Next 'en cas d'erreur, on continue sans générer d'erreur
Set MaNewFeuille = Sheets(Nom)
On Error GoTo 0 'on réactive la gestion d'erreur
'On vérifie si la variable a obtenu un objet ou non
If Not MaNewFeuille Is Nothing Then message = MsgBox("Voulez vous ?", vbRetryCancel + vbQuestion, "Mon programme")     'Exit Sub ' Si elle existe déjà Msg soit annule ou remplace
 
 
'Sinon on continu
'Add retourne un objet Worksheet, que tu recupere dans MaNewFeuille
Set MaNewFeuille = Sheets.Add(After:=Sheets(Sheets.Count))
 
'Renome la nouvelle feuille
MaNewFeuille.Name = Nom
 
 
 
'   Création tab et mise en page
 
 
Sheets("REF").Select
Range("A1:E17").Select
    Selection.Copy
    Sheets(Nom).Select
    ActiveSheet.Paste
 
    Columns("B:B").ColumnWidth = 20.29
    Columns("C:C").ColumnWidth = 6.29
    Columns("D:D").ColumnWidth = 15.43
    Rows("3:3").Select
    Selection.RowHeight = 20.25
    Rows("4:4").Select
    Selection.RowHeight = 15.75
    Rows("5:5").Select
    Selection.RowHeight = 15.75
    Rows("6:6").Select
    Selection.RowHeight = 15.75
    Rows("7:7").Select
    Selection.RowHeight = 15.75
    Rows("8:8").Select
    Selection.RowHeight = 15.75
    Rows("9:9").Select
    Selection.RowHeight = 15.75
    Rows("10:10").Select
    Selection.RowHeight = 15.75
    Rows("11:11").Select
    Selection.RowHeight = 15.75
    Rows("12:12").Select
    Selection.RowHeight = 15.75
    Rows("13:13").Select
    Selection.RowHeight = 15.75
    Rows("14:14").Select
    Selection.RowHeight = 15.75
    Rows("15:15").Select
    Selection.RowHeight = 15.75
    Rows("16:16").Select
    Selection.RowHeight = 15.75
 
    Range("C4:D4").Select
    Selection.ClearContents
 
     Range("C6:D8").Select
    Selection.ClearContents
 
    Range("C10:D16").Select
    Selection.ClearContents
 
 
 
    Range("C13:D13").Select
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    Selection.Font.Italic = False
    Selection.Font.Italic = True
 
 End Sub
 
 
'   Déclarer variables à copier
 
Sub varcop()
 
    Dim CLI As Range
 
    Dim REC As Range
 
    Dim PAY As Range
 
    Dim DS As Range
 
    Dim SF As Range
 
    Dim VD As Range
 
    Dim AMCCY1 As Range
 
    Dim AMCCY2 As Range
 
    Dim CCYO As Range
 
    Dim CCYT As Range
 
    Dim RATE As Range
 
 
 
'  Dètermine destination variables ds "deal" worksheet
 
 For i = 1 To 10
 
    Set CLI = CLI & "_" & i = Sheets(Nom).Range("C6:D6")
 
    Set REC = REC & "_" & i = Sheets(Nom).Range("C14:D14")
 
 
    Set PAY = PAY & "_" & i = Sheets(Nom).Range("C15:D15")
 
 
    Set DS = DS & "_" & i = Sheets(Nom).Range("C4:D4")
 
 
    Set SF = SF & "_" & i = Sheets(Nom).Range("C7:D7")
 
 
    Set VD = VD & "_" & i = Sheets(Nom).Range("C8:D8")
 
 
    If Worksheets("2401").Range("G27").Value > 0 Then
    Set AMCCY1 = AMCCY1 & "_" & i = Sheets(Nom).Range("D11")
    Else
    Set AMCCY2 = AMCCY2 & "_" & i = Sheets(Nom).Range("D12")
    End If
 
 
    If Worksheets("2401").Range("H27").Value < 0 Then
    Set AMCCY2 = AMCCY2 & "_" & i = Sheets(Nom).Range("D12")
    Else
    Set AMCCY2 = AMCCY2 & "_" & i = Sheets(Nom).Range("D11")
    End If
 
    If Worksheets("2401").Range("G27").Value > 0 Then
    Set CCYO = CCYO & "_" & i = Sheets(Nom).Range("C11")
    Else
    Set CCYO = CCYO & "_" & i = Sheets(Nom).Range("C12")
    End If
 
    If Worksheets("2401").Range("H27").Value < 0 Then
    Set CCYT = CCYT & "_" & i = Sheets(Nom).Range("C12")
    Else
    Set CCYT = CCYT & "_" & i = Sheets(Nom).Range("C11")
    End If
 
    Set RATE = RATE & "_" & i = Sheets(Nom).Range("C13:D13")
 
   Next i
 
 
'   Transfère PO data
 
 Dim intcount As Integer
    For intcount = 1 To 11
        For i = 1 To 10
            Select Case intcount
            Case 1: CLI = CLI & "_" & i = Range(CLI & "_" & i)
            Case 2: REC = REC & "_" & i = Range(REC & "_" & i)
            Case 3: PAY = PAY & "_" & i = Range(PAY & "_" & i)
            Case 4: DS = DS & "_" & i = Range(DS & "_" & i)
            Case 5: SF = SF & "_" & i = Range(SF & "_" & i)
            Case 6: VD = VD & "_" & i = Range(VD & "_" & i)
            Case 7: AMCCY1 = AMCCY1 & "_" & i = Range(AMCCY1 & "_" & i)
 
                    'AMCCY1 = AMCCY1 & "_" & i.NumberFormat = "0.0000"
 
            Case 8:  AMCCY2 = AMCCY2 & "_" & i = Range(AMCCY2 & "_" & i)
 
                     'AMCCY2 = AMCCY2 & "_" & i.NumberFormat = "0.0000"
 
            Case 9: CCYO = CCYO & "_" & i = Range(CCYO & "_" & i)
            Case 10: CCYT = CCYT & "_" & i = Range(CCYT & "_" & i)
            Case 11: RATE = RATE & "_" & i = Range(RATE & "_" & i)
        End Select
        Next i
    Next intcount
 
End Sub
 
Sub contpart()
 
'Trouver la contrp
 
Dim TheCell As Range
 
'on recherche dans cet intervale de cellules si un mot existe
'On va donc boucler sur chaque cellule et tester son contenu
For Each TheCell In Worksheets(Nom).Range("C14:D15")
    'For va executer le code autant de fois que de cellule contenu dans l'interval C14:D14
    'A chaque execution TheCEll representera la cellule pointée par la boucle For
    '1ere execution thecell correspond a C14, 2eme execution TheCell correspond a D14
    '3eme execution TheCEll correspond a C15, 4eme execution TheCell correspond a D15
 
    'on regarde le contenu et on choisit ce que l'on doit mettre a la place en fonction de celui ci
    If TheCell.Value = "DEUT" Then
        'On change la valeur contenu dans TheCell
        TheCell.Value = "DEUTSCHE BANK FFT"
    ElseIf TheCell.Value = "CITINY" Then
        TheCell.Value = "CITIBANK NEW YORK"
    End If
Next ' on retourne au For et TheCell reprèsente la cellule suivante
End Sub
 
Sub TypOpe()
 
Dim Ope As Variant
Dim today As Date
 
 
Ope = Sheets(Sheets.Count).Range("F27")
 
today = Date
 
    If Ope = today Then
        Sheets(Sheets.Count).Select
        Range("C7:D7") = "TODAY"
    End If
 
    If Ope = today + 1 Then
        Sheets(Sheets.Count).Select
        Range("C7:D7") = "TOM"
    End If
 
    If Ope = today + 2 Then
        Sheets(Sheets.Count).Select
        Range("C7:D7") = "SPOT"
    End If
 
    If Ope = today + 3 Then
        Sheets(Sheets.Count).Select
        Range("C7:D7") = "FORW"
    End If
 
End Sub
 
 
Sub transvalneg()
 
 
Dim TheCel As Range
 
For Each TheCel In Sheets(Sheets.Count).Range("D11: D12 ")
 
    If TheCel.Value < 0 Then
        TheCel.Value = TheCel * -1
    ElseIf TheCel.Value > 0 Then
        TheCel.Value = TheCel
    End If
Next
End Sub

et pr la page this workbook

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
 
Option Explicit
Private Sub Workbook_Open()
 
Call CréatNoms
 
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim listdon As Variant
Dim lign As Byte
Dim donexp As String
With Target
        If .Column <> 4 Or .Row < 10 Then Exit Sub
        lign = .Row - 9
        listdon = Array("CLI", "REC", "PAY", "DS", "SF", "VD", "AMCCY1", "AMCCY2", "CCYO", "CCYT", "RATE")
        donexp = ""
        For Each donnée In listdon
                donexp = donexp & Range(donnée & "_" & lign)
        Next donnée
        ActiveSheet.Range("M" & .Row).Value = donexp
End With
 
Call Transf_Data
Call varcop
Call contpart
Call TypOpe
Call transvalneg
 
End Sub

merci