Distribution de valeurs concaténées

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 ..... dc je sollicite votre aide et votre savoir en vba car etant débutant c est tres tres dur les debuts

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 (2501) et "x" (0102) 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 (C15;D15), derniere case 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 :

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 :

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 bcp
Contactez moi par mail ... pr le fichier comme ça on y travail ensemble .... ça serait tres sympa car j ai besoin d un gros coup de mains