Bonjour à toutes et tous
Bonjour François

C'est bien ce qu'il me semblait. Essaie ce code :

Sub lance()
Dim tablo

' dechet bleu
' rempl vert
' sav rouge
' solde jaune
' violet total

If IsError(Range("AD1")) Then val_cel = True: Range("AD15").Value = "": Exit Sub
tablo = Split(Range("AD1").Value, ":")
tablo_01 = Split(Mid(Range("AD1"), Len(tablo(0)) + 3), "       ")
t0 = tablo_01(0)    ' rempl
tablo_02 = Split(tablo_01(1), "  ")
t1 = tablo_02(0)    ' dechet
t2 = tablo_02(1)    ' soldes
tablo_03 = Split(tablo_01(2), "  ")
t3 = tablo_03(0)    ' sav
t4 = tablo_03(1)    ' total

val_cel = True

ActiveSheet.Shapes("Rectangle 17").Select   ' il serait bon de donner un nom à cette forme
Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 10
With Selection
    .Characters.Text = Range("AD1").Value   ' cellule où est située la formule : AD15, AD153, ..... à toi d'adapter
    .Characters.Font.ColorIndex = 0 ' titre
    .Characters(Start:=Len(tablo(0)), Length:=Len(t0) + 3).Font.ColorIndex = 50  ' rempl
    .Characters(Start:=Len(tablo(0)) + Len(t0) + 10, Length:=Len(t1)).Font.ColorIndex = 41 ' dechet
    .Characters(Start:=Len(tablo(0)) + Len(t0) + 10 + Len(t1) + 2, Length:=Len(t2)).Font.ColorIndex = 44 ' soldes
    .Characters(Start:=Len(tablo(0)) + Len(t0) + 10 + Len(t1) + 2 + Len(t2) + 7, Length:=Len(t3)).Font.ColorIndex = 3 ' sav
    .Characters(Start:=Len(tablo(0)) + Len(t0) + 10 + Len(t1) + 2 + Len(t2) + 7 + Len(t3) + 2, Length:=Len(t4)).Font.ColorIndex = 7 ' total
End With

val_cel = False
Range("N10").Select
End Sub

Dis nous

Eric

Bonjour à toutes et tous
Bonjour François

".... ça marche nickel ..." c'est toujours agréable de lire cela 

Pour la zone de texte, c'est possible, mais laisse moi un petit peu de temps .....  Auras tu également besoin du résultat dans la cellule "AD15" ou "153" ou .... ?

Pour le bouton "résolu" regarde ce lien :
http://www.mdf-xlpages.com/modules/smartfaq/faq.php?faqid=29

A+
Eric

Bonsoir à toutes et tous

Bonsoir François

Tu trouveras dans le fichier joint des explications plus claires, j'espère. Il te reste à faire les adaptations si tu changes de cellules. 

Après, il suffit seulement de modifier le TCD et le résultat se met à jour. 

A te lire
Eric

Bonjour à toutes et tous
Bonjour François

En formule, je ne sais pas faire. Je te propose une solution en VBA. Dans le fichier texte joint, il y a ce qu'il faut saisir (copier/coller) et où.

Je me suis permis 2 modifications : 

-1- j'ai mis la formule dans la cellule "AD1" (tu peux la mettre ailleurs si tu veux, mais il faudra adapter le code) pour ne récupérer que le résultat dans la cellule "AD15". 

-2- Pour une question pratique, je me suis permis d'ajouter un espace à 2 endroits, ne les enlève pas. Prends la formule ci-dessous (cela ne change en rien au résultat "calcul" et "aspect") :

=CONCATENER("Coût Moyen / Semaine [CHF] :"&" "&CAR(10)&"Rempl. :"&" "&TEXTE((SOMME(Q13:Q54)-LIREDONNEESTABCROISDYNAMIQUE("Coût NC";$N$13;"Raison";"Remplacement"))/NB(N13:N54);"#'##0");""&"       "&"Déchet : "&TEXTE((SOMME(O13:O54)-LIREDONNEESTABCROISDYNAMIQUE("Coût NC";$N$13;"Raison";"Déchet"))/NB(N13:N54);"#'##0");""&"  "&CAR(10)&"Solde PF :"&" "&TEXTE((SOMME(U13:U54)-LIREDONNEESTABCROISDYNAMIQUE("Coût NC";$N$13;"Raison";"Solde PF"))/NB(N13:N54);"#'##0");""&"       "&"SAV : "&TEXTE((SOMME(S13:S54)-LIREDONNEESTABCROISDYNAMIQUE("Coût NC";$N$13;"Raison";"SAV"))/NB(N13:N54);"#'##0");""&"  "&CAR(10)&"Total :"&" "&TEXTE((SOMME(W13:W54)-LIREDONNEESTABCROISDYNAMIQUE("Coût NC";$N$13))/NB(N13:N54);"#'##0"))

Dis moi si j'ai loupé quelque chose. J'adapterai si possible.

A te lire
Eric

Avec le fichier !!

Bonsoir à toutes et tous

Bonsoir François

Est-ce comme l'image jointe que tu aimerais ?

A te lire

Eric

Bonjour à toutes et tous

Bonjour Jad73

Tu aurais pu continuer le post que tu as ouvert sur le site "VeriTi" et y poser la question. Néanmoins, un code pas top mais qui répond à ta question :

Sub select_cellules()
Dim i As Integer
Dim derlign As Integer

derlign = Range("E2").End(xlDown).Row
For i = 2 To derlign
    Range("F" & i).Select
Next i
End Sub

A te lire 

Eric

Bonjour à Toutes et tous

Bonjour olindo, Guy

Tu pourrais essayer ce code :

Option Explicit

Sub sauvegarde_supprime_renomme()

Dim fso, FL, FD

Set fso = CreateObject("Scripting.FileSystemObject")
 
ThisWorkbook.SaveAs "D:\Programmation\00_test" & "Classeur1" & ".xls "  'Sauvergarde du fichier dans dossier temporaire

Kill "D:\Programmation\0_test\Classeur1.xls"          ' destruction du fichier dans ancien dossier
Set FD = fso.GetFolder("D:\Programmation\0_test")
    FD.Name = "000_test"			      ' Nouveau nom du dossier
Set fso = Nothing
Set FL = Nothing
Set FD = Nothing
End Sub

D:\Programmation\00_test\   dossier provisoire

D:\Programmation\0_test\  dossier ancien à renomer

D:\Programmation\000_test\  nouveau nom dossier

Classeur1.xls   nom du fichier

A te lire

Eric

Bonjour à tous

Bonjour olindo

Essaie de détruire le fichier "toto.xlsm" qui se trouve dans "ancien dossier".

Eric

Bonjour à tous

Bonjour Lulu

Pas facile de répondre à tes questions sans connaitre la structure du fichier.

Pourrais tu déposer un fichier (attention aux données perso !) ?

A te lire

Eric