Enregistrement données d'un formulaire dans deux feuilles

Freddyfbb -  
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   -
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:

1 réponse

Réponse 1 / 1
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
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

0
Freddyfbb
 
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

0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 313 > Freddyfbb
 
Où doit on répondre ?
https://www.developpez.net/forums/d1572188/logiciels/microsoft-office/excel/extraction-donnee-vers-nouveau-fichier-excel/

Post crossing sauvage
0