Microsoft 365 Transférer les données entrées dans un userform d'un classeur et les transférer dans les cellules d'un autre classeur

[Arch974]

Bonjour,

J'ai un classeur "Détail" qui contient un userform et je souhaite que lorsque j'entre mes données celles-ci et le résultat du prix calculer apparaissent dans les cellules d'un autre classeur "Devis" en ouvrant les fichiers ça sera plus clair.

Merci d'avance.

 

[job75]

Bonjour Arch974, le forum,

Téléchargez les fichiers joints dans le même dossier (le bureau).

Le code de l'UserForm :

Private Sub CommandButton1_Click()
Dim chemin$, fichier$, v#, lig&
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "devis.xlsx") 'nom à adapter
If fichier = "" Then MsgBox "Fichier '" & fichier & "' introuvable !", 48: Exit Sub
If cb_CIT.ListIndex = -1 Then CommandButton2_Click: cb_CIT.DropDown: Exit Sub
v = Val(Replace(tb_Qte, ",", ".")): tb_Qte = v
If v <= 0 Then tb_Qte = "": tb_Qte.SetFocus: Exit Sub
Application.ScreenUpdating = False
With Workbooks.Open(chemin & fichier).Sheets(1) 'ouvre le fichier
    lig = .[A1].CurrentRegion.Rows.Count + 1
    .Cells(lig, 1) = cb_CIT
    .Cells(lig, 2) = v
    .Cells(lig, 4) = Val(Replace(tb_Prix, ",", "."))
    .Cells(lig, 3) = .Cells(lig, 4) / v
    .Parent.Close True 'enregistre et ferme le fichier
End With
MsgBox "Le fichier '" & fichier & "' a été mis à jour"
End Sub

Private Sub CommandButton2_Click()
cb_CIT = ""
tb_Qte = ""
tb_Prix = ""
End Sub

Private Sub tb_Qte_Change()
If cb_CIT.ListIndex = -1 Then CommandButton2_Click: cb_CIT.DropDown _
    Else tb_Prix = Val(Replace(tb_Qte, ",", ".")) * Range("H" & cb_CIT.ListIndex + 2)
End Sub

Private Sub UserForm_Initialize()
Dim fin&, i&
With Sheets("Detail-Revetement")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne
    For i = 2 To fin 'on charge le combo CIT avec les elements de la colonne A
        cb_CIT.AddItem .Range("A" & i)
    Next i
End With
End Sub

A+

 

[Arch974]

Bonjour Arch974, le forum,

Téléchargez les fichiers joints dans le même dossier (le bureau).

Le code de l'UserForm :

Private Sub CommandButton1_Click()
Dim chemin$, fichier$, v#, lig&
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "devis.xlsx") 'nom à adapter
If fichier = "" Then MsgBox "Fichier '" & fichier & "' introuvable !", 48: Exit Sub
If cb_CIT.ListIndex = -1 Then CommandButton2_Click: cb_CIT.DropDown: Exit Sub
v = Val(Replace(tb_Qte, ",", ".")): tb_Qte = v
If v <= 0 Then tb_Qte = "": tb_Qte.SetFocus: Exit Sub
Application.ScreenUpdating = False
With Workbooks.Open(chemin & fichier).Sheets(1) 'ouvre le fichier
    lig = .[A1].CurrentRegion.Rows.Count + 1
    .Cells(lig, 1) = cb_CIT
    .Cells(lig, 2) = v
    .Cells(lig, 4) = Val(Replace(tb_Prix, ",", "."))
    .Cells(lig, 3) = .Cells(lig, 4) / v
    .Parent.Close True 'enregistre et ferme le fichier
End With
MsgBox "Le fichier '" & fichier & "' a été mis à jour"
End Sub

Private Sub CommandButton2_Click()
cb_CIT = ""
tb_Qte = ""
tb_Prix = ""
End Sub

Private Sub tb_Qte_Change()
If cb_CIT.ListIndex = -1 Then CommandButton2_Click: cb_CIT.DropDown _
    Else tb_Prix = Val(Replace(tb_Qte, ",", ".")) * Range("H" & cb_CIT.ListIndex + 2)
End Sub

Private Sub UserForm_Initialize()
Dim fin&, i&
With Sheets("Detail-Revetement")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne
    For i = 2 To fin 'on charge le combo CIT avec les elements de la colonne A
        cb_CIT.AddItem .Range("A" & i)
    Next i
End With
End Sub

A+

Merci beaucoup ça fonctionne du tonnerre.

 

[Arch974]

Bonjour Arch974, le forum,

Téléchargez les fichiers joints dans le même dossier (le bureau).

Le code de l'UserForm :

Private Sub CommandButton1_Click()
Dim chemin$, fichier$, v#, lig&
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "devis.xlsx") 'nom à adapter
If fichier = "" Then MsgBox "Fichier '" & fichier & "' introuvable !", 48: Exit Sub
If cb_CIT.ListIndex = -1 Then CommandButton2_Click: cb_CIT.DropDown: Exit Sub
v = Val(Replace(tb_Qte, ",", ".")): tb_Qte = v
If v <= 0 Then tb_Qte = "": tb_Qte.SetFocus: Exit Sub
Application.ScreenUpdating = False
With Workbooks.Open(chemin & fichier).Sheets(1) 'ouvre le fichier
    lig = .[A1].CurrentRegion.Rows.Count + 1
    .Cells(lig, 1) = cb_CIT
    .Cells(lig, 2) = v
    .Cells(lig, 4) = Val(Replace(tb_Prix, ",", "."))
    .Cells(lig, 3) = .Cells(lig, 4) / v
    .Parent.Close True 'enregistre et ferme le fichier
End With
MsgBox "Le fichier '" & fichier & "' a été mis à jour"
End Sub

Private Sub CommandButton2_Click()
cb_CIT = ""
tb_Qte = ""
tb_Prix = ""
End Sub

Private Sub tb_Qte_Change()
If cb_CIT.ListIndex = -1 Then CommandButton2_Click: cb_CIT.DropDown _
    Else tb_Prix = Val(Replace(tb_Qte, ",", ".")) * Range("H" & cb_CIT.ListIndex + 2)
End Sub

Private Sub UserForm_Initialize()
Dim fin&, i&
With Sheets("Detail-Revetement")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne
    For i = 2 To fin 'on charge le combo CIT avec les elements de la colonne A
        cb_CIT.AddItem .Range("A" & i)
    Next i
End With
End Sub

A+

le seul hic c'est que ça referme à chaque fois le classeur "Devis" quand on envoi les valeurs.

 

[job75]

le seul hic c'est que ça referme à chaque fois le classeur "Devis" quand on envoi les valeurs.

Vous pouvez alors utiliser ce fichier (2).

Edit : l'UserForm doit être ouvert en non modal.

 

[Arch974]

Vous pouvez alors utiliser ce fichier (2).

Edit : l'UserForm doit être ouvert en non modal.

Merci pour ta rapidité, alors ça ne se ferme pas lorsque je rajoute une valeur par contre certain calcul il me donne le prix qui est nul alors que dans la première version tous les calculs fonctionnaient parfaitement.