Enregistrer sur deux feuilles

apdf1

XLDnaute Impliqué
Bonjour,

J'ai un USF avec Plusieurs Textbox, combobox. Est il possible d'avoir un code qui me permet d'enregistrer sur deux feuilles du même classeur mais sur des colonnes différente "feuille bon_reservation et feuille entrer.

Ci-joint mon fichier qui seras plus parlant.

Je vous remercie par avance et vous souhaite une bonne journée

Cordialement

Max
 

Fichiers joints

apdf1

XLDnaute Impliqué
Re : Enregistrer sur deux feuilles

Bonjour à tous

Est-il possible de le faire? peut être que nom.....

@+

Max
 

Pierrot93

XLDnaute Barbatruc
Re : Enregistrer sur deux feuilles

Bonjour,

Est-il possible de le faire? peut être que nom.....
oui, il suffit de doubler les instructions en précisant les bons objets :
Code:
Sheets("NomFeuille 1").Range("A1").Value = TextBox1
Sheets("NomFeuille 2").Range("B1").Value = TextBox1
bonne journée
@+
 

apdf1

XLDnaute Impliqué
Re : Enregistrer sur deux feuilles

Bonjour Pierrot,

Oui comment faut-il les mettrent a chaque ligne qu'il doit être en double?

Ci joint mon debut de code

Code:
Private Sub btnOK_Click()
Dim Ctrl As Control
    For Each Ctrl In Frame1.Controls
        If Ctrl.Object.Value = True Then
           With Sheets("Entrer")
           L = .Range("A65000").End(xlUp).Row + 1
           
               Cells(L, 1) = "N° " & LabelID
                Cells(L, 2) = cboRace.Value 'Race
                 Cells(L, 3) = T3.Value 'nom
                  Cells(L, 4) = cboSexe.Value 'Sexe
                   Cells(L, 5) = T5.Value 'Né(e) le
                    Cells(L, 6) = T6.Value 'Taile
                     Cells(L, 7) = T7.Value 'N° LOF
                      Cells(L, 8) = T8.Value 'Tatouag
@+

Max
 

Pierrot93

XLDnaute Barbatruc
Re : Enregistrer sur deux feuilles

Re,

déjà si la propriété "cells" doit s'appliquer à la feuille du bloc "with", il est préférable de mettre un point devant "cells"....

sinon, tu fais 2 blox "with" distincts... ou tu précises le nom de la feuille devant le "cells" :
Code:
Sheets("NomFeuille").Cells(L, 1) = "N° " & LabelID
A voir si ta variable "L" sera toujours d'actualité aussi sur cette feuille...
 

apdf1

XLDnaute Impliqué
Re : Enregistrer sur deux feuilles

Re,

Oui sa marche super bien je peut renseigner les deux feuilles dans les cellules approprier.

Mais est-il possible via la combobox lui dire si oui ou non elle doit être copier sur les deux feuilles ?
et si oui comment ?

@+
 

Pierrot93

XLDnaute Barbatruc
Re : Enregistrer sur deux feuilles

Re,

Mais est-il possible via la combobox lui dire si oui ou non elle doit être copier sur les deux feuilles ?
et si oui comment ?
oui, sans doute, en précisant les critères via une instruction "IF"...
 

apdf1

XLDnaute Impliqué
Re : Enregistrer sur deux feuilles

Re,

Oui mais je ne connais pas le code pour mettre l'instruction "IF"
ou peut être sa
Code:
If cboOnglet.ListIndex > -1 Then
 

Pierrot93

XLDnaute Barbatruc
Re : Enregistrer sur deux feuilles

Re,

regarde ceci, après tout dépend des critères....
Code:
With ComboBox1
    If .ListIndex <> -1 Then
        If .Value = "1" Then
           'code alimentation feuille 1
        Else
           'code alimentation feuille 2
        End If
    End If
End With
 

apdf1

XLDnaute Impliqué
Re : Enregistrer sur deux feuilles

Re,

je suis coincé au niveau 'code alimentation feuille' je ne sais pas quoid mettre

@
 

Pierrot93

XLDnaute Barbatruc
Re : Enregistrer sur deux feuilles

Re,

bah... ce que tu avais déjà fait :
Code:
With Sheets("Entrer")
           L = .Range("A65000").End(xlUp).Row + 1
           
               Cells(L, 1) = "N° " & LabelID
                Cells(L, 2) = cboRace.Value 'Race
                 Cells(L, 3) = T3.Value 'nom
                  Cells(L, 4) = cboSexe.Value 'Sexe
                   Cells(L, 5) = T5.Value 'Né(e) le
en tenant compte des remarques précédentes....
 

apdf1

XLDnaute Impliqué
Re : Enregistrer sur deux feuilles

Re,

Voila comment j'ai fait j'ai du faire une boulette parce que sa ne marche pas quand je ne veut pas copier sur les deux feuille.

Code:
Private Sub btnOK_Click()
Dim Ctrl As Control
    For Each Ctrl In Frame1.Controls
        If Ctrl.Object.Value = True Then
           With Sheets("Entrer")
           L = .Range("A65000").End(xlUp).Row + 1
  

       With cboOnglet
    If .ListIndex <> -1 Then
        If .Value = "1" Then
               
           
           Sheets("Entrer").Cells(L, 2).Value = T3
           Sheets("Entrer").Cells(L, 3).Value = cboRace.Value
           Sheets("Entrer").Cells(L, 10).Value = cboCouleur.Value
           Sheets("Entrer").Cells(L, 5).Value = T5
           Sheets("Entrer").Cells(L, 4).Value = cboSexe.Value 'Sexe
           Sheets("Entrer").Cells(L, 11).Value = T11
           Sheets("Entrer").Cells(L, 12).Value = T12
           Sheets("Entrer").Cells(L, 7).Value = T7
           Sheets("Entrer").Cells(L, 6).Value = T6 'Taille
           Sheets("Entrer").Cells(L, 21).Value = Ctrl.Caption & " " & T21.Value
           Sheets("Entrer").Cells(L, 22).Value = T22
           Sheets("Entrer").Cells(L, 23).Value = T23
           Sheets("Entrer").Cells(L, 24).Value = T24
           Sheets("Entrer").Cells(L, 1).Value = "N° " & LabelID
           Sheets("Entrer").Cells(L, 24).Value = T28
    Else
           Sheets("Bon_Reservation").Range("B14").Value = T3 'Nom
           Sheets("Bon_Reservation").Range("B15").Value = cboRace.Value 'Race
           Sheets("Bon_Reservation").Range("B16").Value = cboCouleur.Value 'Couleur
           Sheets("Bon_Reservation").Range("B17").Value = T5 'Date de naissance
           Sheets("Bon_Reservation").Range("B18").Value = T11 'pere
           Sheets("Bon_Reservation").Range("B19").Value = T12 'mere
           Sheets("Bon_Reservation").Range("B20").Value = T7 'N° LOF
           Sheets("Bon_Reservation").Range("B21").Value = cboPuce.Value 'Puce
           Sheets("Bon_Reservation").Range("C21").Value = cboVaccine.Value 'Vacciné
           Sheets("Bon_Reservation").Range("B3").Value = Ctrl.Caption & " " & T21.Value 
           Sheets("Bon_Reservation").Range("B4").Value = T22 'Adresse
           Sheets("Bon_Reservation").Range("B5").Value = T23 'CP
           Sheets("Bon_Reservation").Range("B6").Value = T24 'Ville
           Sheets("Bon_Reservation").Range("B7").Value = T28 'Tel
           
           
                  End If
    End If
End With
@+

Max
 

Pierrot93

XLDnaute Barbatruc
Re : Enregistrer sur deux feuilles

Re,

en l'état écrira sur une seule feuille, soit sur feuille "Entrer" si valeur = à "1" dans la combo soit sur la feuille "Bon_Reservation" si autre valeur dans combo...
 

apdf1

XLDnaute Impliqué
Re : Enregistrer sur deux feuilles

Re,

Avec la meilleur volonter je n'y arrive pas il doit y avoir un probleme ou alors je me suis planté si tu veut regarder mon code et voir ou j'ai l'erreur ?

Je te remercie d'avance

Voici mon code au complet:

Code:
Private Sub UserForm_Initialize()
    ' cboOnglet
    With cboOnglet
        .Style = fmStyleDropDownList
        .AddItem "Bon_Reservation"
        .AddItem ""
       
    End With
    
     With cboRace ' Race
        .AddItem "Westie"
        .AddItem "Cavalier C.K.C "
        .AddItem "Lévrier "
        .AddItem "Yorkshire "
    End With
    
 With cboSexe 'Sexe
        .AddItem "F"
        .AddItem "M"
    End With
    
 With cboCouleur ' couleur
        .AddItem "Blenheim"
        .AddItem "Rubis "
        .AddItem "Noir & Feu "
        .AddItem "Tricolore "
        .AddItem "Bleu acier foncé "
    End With

With cboReglement 'Réglement
        .AddItem "Espèce"
        .AddItem "Chèque"
        .AddItem "Carte"
        End With
        
 With cboPuce 'Puce
        .AddItem "Oui"
        .AddItem "Nom"
        End With
        
With cboVaccine 'Vaccine
        .AddItem "Oui"
        .AddItem "Nom"
        End With
        
      
 With cboVisite 'Visite
    For i = 1 To 12
        .AddItem i
    Next i
End With
    
    IniLabelID
End Sub
Sub IniLabelID()
With Sheets("Entrer")
    LabelID = Application.CountA(.Range("A1:A" & .Range("A65000").End(xlUp).Row))  'mettre la lettre de la colonne pour le N°du LabelID
End With

End Sub

'Ajouter
Private Sub btnOK_Click()
Dim Ctrl As Control
    For Each Ctrl In Frame1.Controls
        If Ctrl.Object.Value = True Then
           With Sheets("Entrer")
           L = .Range("A65000").End(xlUp).Row + 1

       '    With cboOnglet
   ' If .ListIndex <> -1 Then
       ' If .Value = "1" Then
        '     Sheets ("Entrer") 'code alimentation feuille 1
       ' End With
        'Else
           ' Sheets ("Bon_Reservation") 'code alimentation feuille 2
       
        'End If
    'End If
           
           With Sheets("Entrer")
           
           .Cells(L, 2).Value = T3
           .Cells(L, 3).Value = cboRace.Value
           .Cells(L, 10).Value = cboCouleur.Value
           .Cells(L, 5).Value = T5
           .Cells(L, 4).Value = cboSexe.Value 'Sexe
           .Cells(L, 11).Value = T11
           .Cells(L, 12).Value = T12
           .Cells(L, 7).Value = T7
           .Cells(L, 6).Value = T6 'Taille
           .Cells(L, 21).Value = Ctrl.Caption & " " & T21.Value
           .Cells(L, 22).Value = T22
           .Cells(L, 23).Value = T23
           .Cells(L, 27).Value = T28
           .Cells(L, 1).Value = "N° " & LabelID
           .Cells(L, 24).Value = T24
           .Cells(L, 8).Value = T8 'Tatouage
           .Cells(L, 9).Value = T9 'Puce
           .Cells(L, 13).Value = T13 'N° lof Parents
           .Cells(L, 14).Value = Format(T14, "0.00 €") 'Prix
           .Cells(L, 15).Value = T15 'Date
           .Cells(L, 16).Value = Format(T16, "0.00 €") 'Acompte
           .Cells(L, 17).Value = T17 'Date
           .Cells(L, 18).Value = Format(T18, "0.00 €") 'Acompte
           .Cells(L, 19).Value = Format(T19, "0.00 €") 'Solde
           .Cells(L, 20).Value = cboReglement 'Reglement
           .Cells(L, 25).Value = T25 'Département
           .Cells(L, 26).Value = T26 & "@" & T27  'Email
           .Cells(L, 28).Value = T29 'Mobile
           .Cells(L, 29).Value = T30 'Fax
           .Cells(L, 30).Value = cboVisite 'Nbre visite
           .Cells(L, 31).Value = T31 'Date Modif
             .Hyperlinks.Add .Cells(L, 26), Address:="mailto:" & "T26 &  T27" 'Email actif sur la feuille
           
           With Sheets("Bon_Reservation")
           
           .Range("B14").Value = T3 'Nom
           .Range("B15").Value = cboRace.Value 'Race
           .Range("B16").Value = cboCouleur.Value 'Couleur
           .Range("B17").Value = T5 'Date de naissance
           .Range("B18").Value = T11 'pere
           .Range("B19").Value = T12 'mere
           .Range("B20").Value = T7 'N° LOF
           .Range("B21").Value = cboPuce.Value 'Puce
           .Range("D21").Value = cboVaccine.Value 'Vaccine
           .Range("B3").Value = Ctrl.Caption & " " & T21.Value 'Nom propriétaire
           .Range("B4").Value = T22 'Adresse
           .Range("B5").Value = T23 'CP
           .Range("B6").Value = T24 'Ville
           .Range("B7").Value = T28 'Tel
           .Range("C23").Value = Format(T14, "0.00 €") 'Prix
           .Range("B27").Value = Format(T16, "0.00 €") 'Acompte
           
End With
'


IniLabelID
      End With
      End With
      End If
      Next Ctrl
End Sub
@+
Max
 

apdf1

XLDnaute Impliqué
Re : Enregistrer sur deux feuilles

Re,

Une fois il me dit message d'erreur "End With sans With " aprés c'est" End If sans bloc IF"
Et comment mettre le code que tu ma donnée

@+
 

Pierrot93

XLDnaute Barbatruc
Re : Enregistrer sur deux feuilles

Re,

regarde ceci, à noter placer ainsi des codes sur le forum n'est pas très lisible, il est préférable d'exposer uniquement le problème dans un tout petit fichier avec juste les éléments qu'ils faut pour le démontrer(un usf, un textbox un combo), en procédant ainsi je jense que tu aurais eut ta réponse depuis longtemps... :
Code:
Private Sub btnOK_Click()
Dim Ctrl As Control
    For Each Ctrl In Frame1.Controls
        If Ctrl.Object.Value = True Then
            L = Sheets("Entrer").Range("A65000").End(xlUp).Row + 1
            With Sheets("Entrer")
               .Cells(L, 2).Value = T3
               .Cells(L, 3).Value = cboRace.Value
               .Cells(L, 10).Value = cboCouleur.Value
               .Cells(L, 5).Value = T5
               .Cells(L, 4).Value = cboSexe.Value 'Sexe
               .Cells(L, 11).Value = T11
               .Cells(L, 12).Value = T12
               .Cells(L, 7).Value = T7
               .Cells(L, 6).Value = T6 'Taille
               .Cells(L, 21).Value = Ctrl.Caption & " " & T21.Value
               .Cells(L, 22).Value = T22
               .Cells(L, 23).Value = T23
               .Cells(L, 27).Value = T28
               .Cells(L, 1).Value = "N° " & LabelID
               .Cells(L, 24).Value = T24
               .Cells(L, 8).Value = T8 'Tatouage
               .Cells(L, 9).Value = T9 'Puce
               .Cells(L, 13).Value = T13 'N° lof Parents
               .Cells(L, 14).Value = Format(T14, "0.00 €") 'Prix
               .Cells(L, 15).Value = T15 'Date
               .Cells(L, 16).Value = Format(T16, "0.00 €") 'Acompte
               .Cells(L, 17).Value = T17 'Date
               .Cells(L, 18).Value = Format(T18, "0.00 €") 'Acompte
               .Cells(L, 19).Value = Format(T19, "0.00 €") 'Solde
               .Cells(L, 20).Value = cboReglement 'Reglement
               .Cells(L, 25).Value = T25 'Département
               .Cells(L, 26).Value = T26 & "@" & T27  'Email
               .Cells(L, 28).Value = T29 'Mobile
               .Cells(L, 29).Value = T30 'Fax
               .Cells(L, 30).Value = cboVisite 'Nbre visite
               .Cells(L, 31).Value = T31 'Date Modif
                 .Hyperlinks.Add .Cells(L, 26), Address:="mailto:" & "T26 &  T27" 'Email actif sur la feuille
            End With
            With Sheets("Bon_Reservation")
                .Range("B14").Value = T3 'Nom
                .Range("B15").Value = cboRace.Value 'Race
                .Range("B16").Value = cboCouleur.Value 'Couleur
                .Range("B17").Value = T5 'Date de naissance
                .Range("B18").Value = T11 'pere
                .Range("B19").Value = T12 'mere
                .Range("B20").Value = T7 'N° LOF
                .Range("B21").Value = cboPuce.Value 'Puce
                .Range("D21").Value = cboVaccine.Value 'Vaccine
                .Range("B3").Value = Ctrl.Caption & " " & T21.Value 'Nom propriétaire
                .Range("B4").Value = T22 'Adresse
                .Range("B5").Value = T23 'CP
                .Range("B6").Value = T24 'Ville
                .Range("B7").Value = T28 'Tel
                .Range("C23").Value = Format(T14, "0.00 €") 'Prix
                .Range("B27").Value = Format(T16, "0.00 €") 'Acompte
            End With
        End If
    Next Ctrl
End Sub
 

apdf1

XLDnaute Impliqué
Re : Enregistrer sur deux feuilles

re,

Je te remercie mais ou est le code que tu ma donne pour la combo !

Code:
With ComboBox1
    If .ListIndex <> -1 Then
        If .Value = "1" Then
           'code alimentation feuille 1
        Else
           'code alimentation feuille 2
        End If
    End If
End With
@+
 

Pierrot93

XLDnaute Barbatruc
Re : Enregistrer sur deux feuilles

Re

bah.. il n'était pas dans le code que tu as déposé à 12h12 et qui te posait problème.....
 

apdf1

XLDnaute Impliqué
Re : Enregistrer sur deux feuilles

Re,

Si si dans le code "Private Sub btnOK_Click()" ou alors mal placer
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas