Microsoft 365 copie valeur texte box dans cellule

[morpheus579]

Bonjour

Je cherche comment copier des valeurs des box texte Acces Drives , Mails et Remarques vers la cellule du classeur " listes Salariés"

Merci pour vos retours

 

[sylvanu]

Bonjour Morpheus,
Dans votre fichier les "Textbox" ne semble pas être de vraies Textbox, cela ressemble à des shapes.
Je les ai remplacées par de vraies Textbox, et le code associé est :

Sub ajout()
    Sheets("Listes Salariés").[L2] = Sheets("Formulaires").TextBox1.Text
    Sheets("Listes Salariés").[M2] = Sheets("Formulaires").TextBox2.Text
    Sheets("Listes Salariés").[N2] = Sheets("Formulaires").TextBox3.Text
End Sub

A vous d'adapter pour ranger les valeurs sur la ligne désirée.

 

[morpheus579]

Bonjour Morpheus,
Dans votre fichier les "Textbox" ne semble pas être de vraies Textbox, cela ressemble à des shapes.
Je les ai remplacées par de vraies Textbox, et le code associé est :

Sub ajout()
    Sheets("Listes Salariés").[L2] = Sheets("Formulaires").TextBox1.Text
    Sheets("Listes Salariés").[M2] = Sheets("Formulaires").TextBox2.Text
    Sheets("Listes Salariés").[N2] = Sheets("Formulaires").TextBox3.Text
End Sub

A vous d'adapter pour ranger les valeurs sur la ligne désirée.

Bonjour Sylvanu

Un grand merci pour ton retour je ne vois pas par contre comment faire un Copier --> Coller les valeurs pour que le champs remplis soit automatiquement dans la cellule de la feuille listes salariés.

Je ne sais pas si mon code est correct déja 🙂

Merci pour ton aide par avance

 

[morpheus579]

oublie pieces jointes

 

[sylvanu]

Re,
Un ex en PJ avec :

Sub ajout()
    DL = 1 + Sheets("Listes Salariés").Range("A65500").End(xlUp).Row  ' Première ligne dispo
    Set F = Sheets("Formulaires")
    With Sheets("Listes Salariés")
        .Cells(DL, "A") = F.[B6]    'Prénom
        .Cells(DL, "B") = F.[E6]    'Nom
        .Cells(DL, "C") = F.[B9]    'Trigramme
        .Cells(DL, "D") = F.[B12]   'Date entrée
        .Cells(DL, "E") = F.[B15]   'Type contrat
        .Cells(DL, "F") = F.[B18]   'Département
        .Cells(DL, "G") = F.[B21]   'Entité
        .Cells(DL, "H") = F.[B24]   'Poste
        .Cells(DL, "I") = F.[B27]   'Partners
        .Cells(DL, "J") = F.[B30]   'Matériel
        .Cells(DL, "K") = F.[B33]   'GSM
        .Cells(DL, "L") = F.TextBox1.Text   'Acces drive
        .Cells(DL, "M") = F.TextBox2.Text   'Mails
        .Cells(DL, "N") = F.TextBox3.Text   'Remarques
    End With
    'Effacement cellules
    Range("B6:C6,E6:F6,B9:C9,B12:C12,B15:C15,B18:C18,B21:C21,B24:C24,B27:C27,B30:C30,B33:C33").ClearContents
    F.TextBox1.Text = ""
    F.TextBox2.Text = ""
    F.TextBox3.Text = ""
End Sub