Composé un numéro spécial en VBA

cp4

XLDnaute Barbatruc
Bonsoir:),

Pour aider un membre, je sollicite votre aide.
Dans le fichier ci-joint, en feuil1 saisir un chiffre ou un nombre en B3 et des lettres en en B4.
ex: en B3=1 et B4=ABC

le résultat sur la feuil2 en B5-------> 0001-ABC

Et ce en codage; ça parait simple mais je nage. non je coule.

Merci beaucoup.
 

Pièces jointes

  • Code Spe.xlsm
    17.3 KB · Affichages: 11

laurent950

XLDnaute Accro
Bonsoir

VB:
Option Explicit

Sub Bouton1_Cliquer()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Sh1 = Worksheets("Feuil1")
Set Sh2 = Worksheets("Feuil2")

Sh2.Range(Sh2.Cells(5, 2), Sh2.Cells(5, 2)).NumberFormat = "@": Sh2.Cells(5, 2) = "000" & Sh1.Cells(3, 2) & "-" & Sh1.Cells(4, 2)

MsgBox "Eurêka !", vbExclamation, "Super....."
End Sub
 
Dernière édition:

cp4

XLDnaute Barbatruc
Bonsoir Modeste:), Jacky67:), Laurent950:),

Merci beaucoup. J'ai trop simplifié le problème. En fait, les codes se rajoutent en feuille2 en colonne B au fur et à mesure.
J'essaie d'adapter l'un de vos codes.
Encore merci. Bonne soirée.;)
 

cp4

XLDnaute Barbatruc
Bonsoir

VB:
Option Explicit

Sub Bouton1_Cliquer()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Sh1 = Worksheets("Feuil1")
Set Sh2 = Worksheets("Feuil2")

Sh2.Range(Sh2.Cells(5, 2), Sh2.Cells(5, 2)).NumberFormat = "@": Sh2.Cells(5, 2) = "000" & Sh1.Cells(3, 2) & "-" & Sh1.Cells(4, 2)

MsgBox "Eurêka !", vbExclamation, "Super....."
End Sub
Ton code est bon. Mais, je n'avais pas précisé qu'il ne fallait pas plus de 4 chiffres.
Merci quand même, j'apprécie ton aide.
Bonne soirée.;)
 

cp4

XLDnaute Barbatruc
Désolé, de revenir vers vous je viens de tester dans le véritable fichier.
J'ai le petit triangle en haut à gauche de la cellule.
Bizarre! car sur la fichier joint, tout se passe bien.
Capture.JPG
 

Modeste geedee

XLDnaute Barbatruc
Merci beaucoup. J'ai adapté ton code ainsi
VB:
Sub Bouton1_Cliquer()
dl = Sh2.Range("b" & Rows.Count).End(xlUp).Row + 1
Feuil2.[b5] = Format(Feuil1.[B3], "0000-") & Feuil1.[B4]
End Sub
Encore merci. Bonne soirée.:)

utilité de dl ???
plutôt comme ceci alors
Sub Bouton1_cliquer
Feuil2.Range("b" & Rows.Count).End(xlUp).Offset(1, 0) = Format(Feuil1.[B3], "0000-") & Ucase(Feuil1.[B4])
' Feuil1.Range("B3") = Feuil1.Range("B3") + 1
End Sub
upload_2018-12-5_20-0-25.png
 
Dernière édition:

Discussions similaires

Réponses
16
Affichages
981
Réponses
14
Affichages
558