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