Enregistrement données d'un formulaire dans deux feuilles

Fermé

Freddyfbb - 3 mars 2016 à 11:47
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 - 3 mars 2016 à 14:19

Bonjour à Tous,

Juste pour savoir s'il y a possibilité d'enregistrer les informations de mon userform dans deux feuilles différentes lorsque l'on clique sur le seul bouton valider.

Avec une seule feuille, ça marche parfaitement bien mais j'aimerais me servir de la deuxième feuille comme backup pour enregistrer toutes les données en provenance de mon formulaire. L'utilisateur pourra faire des modifications sur les données se trouvant sur la première feuille.

Merci

A voir également:

Enregistrement données d'un formulaire dans deux feuilles
Comment faire un livret avec des feuilles a4 - Guide
Formulaire de réclamation facebook - Guide
Comment faire deux colonnes indépendantes dans word - Guide
Fusionner deux feuilles excel - Guide
Deux ecran pc - Guide

1 réponse

Réponse 1 / 1

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 754
3 mars 2016 à 12:52

Bonjour,

Oui, c'est possible.
La méthode est relativement aisée.
Tu peux utiliser un bloc With...End With pour chacune des feuilles, comme ceci :

Private Sub CommandButton3_Click()
    With Sheets("Feuil1")
        .Range("A3").Value = ComboBox1
        .Range("B3").Value = TextBox1
        .Range("C3").Value = TextBox2
        .Range("D3").Value = TextBox3
    End With
    With Sheets("Feuil2")
        .Range("A3").Value = ComboBox1
        .Range("B3").Value = TextBox1
        .Range("C3").Value = TextBox2
        .Range("D3").Value = TextBox3
    End With
End Sub

Ou, mieux, dans le cas ou les données sont stockées au même endroit dans les deux feuilles, utiliser une fonction :

Private Sub CommandButton3_Click()
Dim maFeuille As WorkSheet

Set maFeuille = WorkSheets("Feuil1")
Transfert_Datas(maFeuille)
Set maFeuille = WorkSheets("Feuil2")
Transfert_Datas(maFeuille)
End Sub

Sub Transfert_Datas(Wsh As WorkSheet)
    With Wsh
        .Range("A3").Value = ComboBox1
        .Range("B3").Value = TextBox1
        .Range("C3").Value = TextBox2
        .Range("D3").Value = TextBox3
    End With
End Sub

Freddyfbb
3 mars 2016 à 14:14

Bonjour,

J'ai essayé d'adapter ces codes à mon formulaire mais l'enregistrement sur la deuxième feuille s'arrête à la deuxième colonne. Il récupère juste la date et la formule pour dégager le mois et l'année. La première colonne devrait se compléter automatiquement et le reste via la fonction vlookup. Tout marche bien avec la première feuille (Détails). Voici les codes qui me permettent de remplir la feuille Détails


Private Sub Validation_Click()
Dim Mat_Benef As String
Dim datej As Date
Dim i As Integer

i = 1
Do While Cells(i, 1) <> ""
Cells(i, 1).Offset(i, 1).Select
i = i + 1
Loop
    With Sheets("Détails")
        Mat_Benef = UserForm1.Matricule_Beneficiaire.Value
        datej = UserForm1.Date_Jour.Value
            If Application.CountIf(Worksheets("Titulaire_PAC").Columns("C"), Mat_Benef) > 0 Then
                Sheets("Détails").Activate
                'ActiveCell.Value = UserForm1.Date_Jour.Value
                ActiveCell.Value = datej
                ActiveCell.Offset(0, 1).Value = Month(datej) & "/" & Year(datej)
                ActiveCell.Offset(0, 2).Value = Mat_Benef
                '------------------------------------------------------------------------
                ActiveCell.Offset(0, 3).Value = Application.WorksheetFunction.VLookup(Mat_Benef, Worksheets("Titulaire_PAC").Range("C:J"), 2, False)
                ActiveCell.Offset(0, 4).Value = Application.WorksheetFunction.VLookup(Mat_Benef, Worksheets("Titulaire_PAC").Range("C:J"), 3, False)
                ActiveCell.Offset(0, 5).Value = Application.WorksheetFunction.VLookup(Mat_Benef, Worksheets("Titulaire_PAC").Range("C:J"), 4, False)
                If ActiveCell.Offset(0, 5).Value <> "" Then
                    ActiveCell.Offset(0, 6).Value = Year(datej) - Year(ActiveCell.Offset(0, 5).Value)
                Else
                    ActiveCell.Offset(0, 6).Value = "-"
                End If
                ActiveCell.Offset(0, 7).Value = Application.WorksheetFunction.VLookup(Mat_Benef, Worksheets("Titulaire_PAC").Range("C:J"), 5, False)
                ActiveCell.Offset(0, 8).Value = Application.WorksheetFunction.VLookup(Mat_Benef, Worksheets("Titulaire_PAC").Range("C:J"), 6, False)
                ActiveCell.Offset(0, 9).Value = Application.WorksheetFunction.VLookup(Mat_Benef, Worksheets("Titulaire_PAC").Range("C:J"), 7, False)
                ActiveCell.Offset(0, 10).Value = Application.WorksheetFunction.VLookup(Mat_Benef, Worksheets("Titulaire_PAC").Range("C:J"), 8, False)
                ActiveCell.Offset(0, 11).Value = UserForm1.Fosa_Provenance.Value
                ActiveCell.Offset(0, 12).Value = UserForm1.Prestations.Value
                ActiveCell.Offset(0, 13).Value = UserForm1.Actes_Medicaux.Value
                ActiveCell.Offset(0, 14).Value = UserForm1.Diagnostics.Value
                ActiveCell.Offset(0, 15).Value = UserForm1.Cout_Prestation.Value
                ActiveCell.Offset(0, 16).Value = UserForm1.txtCDF.Value
                ActiveCell.Offset(0, 17).Value = UserForm1.Fosa_Orientation.Value
                ActiveCell.Offset(0, 18).Value = UserForm1.Observations.Value

        ' Codes pour compléter la colonne ID
            If ActiveCell.Offset(-1, -1).Value = "ID" Then
                ActiveCell.Offset(0, -1).Value = 1
            Else
                ActiveCell.Offset(0, -1).Value = ActiveCell.Offset(-1, -1).Value + 1
            End If
                
                ' Positionnement du curseur à la dernière cellule vide de la colonne
                    With Sheets(ActiveSheet.Name)
                        .Range("b" & .Cells(.Columns(2).Cells.Count, 2).End(xlUp).Row + 1).Select
                    End With
                Unload UserForm1
                Worksheets("Détails").Visible = xlSheetVeryHidden
                Sheets("Acceuil").Activate
    
        Else
            MsgBox "Ce Bénéficiaire n'existe pas la base. Veuillez l'ajouter dans la Feuille Titulaire_PAC avant de continuer avec l'encodage", vbCritical + vbOKOnly, "Erreur de saisi"
            Unload UserForm1
            Worksheets("Titulaire_PAC").Visible = True
            Sheets("Titulaire_PAC").Activate
        End If
    End With
    
    ' Positionnement du curseur à la dernière cellule vide de la colonne
    With Sheets(ActiveSheet.Name)
        .Range("b" & .Cells(.Columns(2).Cells.Count, 2).End(xlUp).Row + 1).Select
    End With
  
End Sub

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 312 > Freddyfbb
3 mars 2016 à 14:19

Où doit on répondre ?
https://www.developpez.net/forums/d1572188/logiciels/microsoft-office/excel/extraction-donnee-vers-nouveau-fichier-excel/

Post crossing sauvage

Discussions similaires

Un seul de mes écouteurs marche. Que faire ?

Comment supprimer une conversation Messenger pour les 2 personnes ?