Export de données d'un formulaire vers un nouveau classeur

Bonjour,

Dans un tableau de suivi financier, j’ai créé un formulaire contenant environ 20 champs à compléter pour chaque opération suivie. Ce formulaire est appelé par un bouton depuis le tableau de suivi (et cela fonctionne parfaitement).

Une fois le formulaire complété, un bouton permet l’ajout des données sur la ligne suivante de l’onglet « test » (je suis en phase de test).

With Worksheets("test")

derlign = .Range("b65536").End(xlUp).Row

For ligne_dd = 1 To 10

If Controls("TextBox" & ligne_dd + 2).Text <> "" Then 'Test valeur financière présente sur Montant

ligne_dd_relle = ligne_dd_relle + 1

.Cells(derlign + ligne_dd_relle, 1) = "à compléter"

.Cells(derlign + ligne_dd_relle, 2) = Label2 'Date

.Cells(derlign + ligne_dd_relle, 3) = "04150177" '

.Cells(derlign + ligne_dd_relle, 4) = TextBox26 ' Action

.Cells(derlign + ligne_dd_relle, 6) = ComboBox3 ' Libellé interne

.Cells(derlign + ligne_dd_relle, 7) = ComboBox2 ' Code activité

.Cells(derlign + ligne_dd_relle, 10) = UserForm1.Controls("TextBox" & ligne_dd + 2) ' montant 01

.Cells(derlign + ligne_dd_relle, 11) = UserForm1.Controls("TextBox" & ligne_dd + 13) ' montant 02

.Cells(derlign + ligne_dd_relle, 12) = TextBox1 'Intitulé

val_part = UserForm1.Controls("Label" & ligne_dd + 19)

val_part = Mid(val_part, 13, 2)

.Cells(derlign + ligne_dd_relle, 9) = val_part ' DD

.Cells(derlign + ligne_dd_relle, 8) = UserForm1.Controls("Label" & ligne_dd + 19) ' Unité

.Cells(derlign + ligne_dd_relle, 14) = ComboBox4 '

Else

End If

Tout fonctionne parfaitement. Je voudrais maintenant exporter l’ensemble des données du formulaire au moment même où il est validé (c’est-à-dire à la suite du code déclenché par l’action du bouton 2) dans un nouveau fichier excel dans un répertoire (toujours le même) en créant à chaque validation, un nouveau fichier dont le nom serait celui du champ libellé.

Ce qui me serait utile, c’est une méthode qui permet l’export des données dans un nouveau fichier sans que cela soit forcément visible par l’utilisateur depuis le formulaire.

Merci pour votre aide.

Cordialement,

Bonjour Laurent, bonjour le forum,

Si j'ai bien compris (ce qui est rare...), ça donnerait ça :

Sub Macro1()
Dim NC As Workbook
Dim CH As String

CH = "X" 'où par exemple X = "Z:\poubelle\Robert\" (sans oublier le dernier \ à la fin), tu mets ton chemin d'accès pour le nouveau classeur

'ton premier code :
'With Worksheets("test")
'derlign = .Range("b65536").End(xlUp).Row
'
'
'For ligne_dd = 1 To 10
'If Controls("TextBox" & ligne_dd + 2).Text <> "" Then 'Test valeur financière présente sur Montant
'    ligne_dd_relle = ligne_dd_relle + 1
'    .Cells(derlign + ligne_dd_relle, 1) = "à compléter"
'    .Cells(derlign + ligne_dd_relle, 2) = Label2 'Date
'    .Cells(derlign + ligne_dd_relle, 3) = "04150177" '
'    .Cells(derlign + ligne_dd_relle, 4) = TextBox26 ' Action
'    .Cells(derlign + ligne_dd_relle, 6) = ComboBox3 ' Libellé interne
'    .Cells(derlign + ligne_dd_relle, 7) = ComboBox2 ' Code activité
'    .Cells(derlign + ligne_dd_relle, 10) = UserForm1.Controls("TextBox" & ligne_dd + 2) ' montant 01
'    .Cells(derlign + ligne_dd_relle, 11) = UserForm1.Controls("TextBox" & ligne_dd + 13) ' montant 02
'    .Cells(derlign + ligne_dd_relle, 12) = TextBox1 'Intitulé
'    val_part = UserForm1.Controls("Label" & ligne_dd + 19)
'    val_part = Mid(val_part, 13, 2)
'    .Cells(derlign + ligne_dd_relle, 9) = val_part ' DD
'    .Cells(derlign + ligne_dd_relle, 8) = UserForm1.Controls("Label" & ligne_dd + 19) ' Unité
'    .Cells(derlign + ligne_dd_relle, 14) = ComboBox4 '
'Else
'End If

Set NC = Workbooks.Add 'définit le nouveau classeur NC en ajoutant un classeur vierge
With NC.Worksheets(1) 'prend en compte le premier onglet de ce classeur
    'ici tu répètes ton premier code...
End With
NC.SaveAs CH & ComboBox3.Value, 51 'enregistre sous avec le chemin CH plus le nom (dans le ComboBox3) et avec le format par défaut (selon ton Excel)
NC.Close 'si nécessaire
End Sub

Monsieur ThauThème,

Merci pour votre aide dans la résolution de ce cas.

Tout fonctionne parfaitement !

Cordialement,

Laurent