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
 

Pièces jointes

  • BON DE RESERVATION.xlsm
    38.5 KB · Affichages: 74

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,

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
 

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
 

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
 

Discussions similaires

Statistiques des forums

Discussions
311 719
Messages
2 081 874
Membres
101 829
dernier inscrit
listener75