XL 2013 Enregistrer de données sur plusieurs feuilles d'un classeur

stammy

XLDnaute Nouveau
Bonjour, je reviens vers vous pour pouvoir m'aider sur ce travail sur lequel je suis bloqué depuis une semaine!
Je suis en train de créer une application de gestion d'un centre social
depuis le userform on introduit les informations sur les personnes et les ateliers dans lesquels ils participent, le hic c'est je voudrais que l'enregistrement des informations soit fait sur plusieurs feuilles sur la feuille FAMILLES et sur les feuilles des ateliers concernés en cochant les cases en bas du formulaire; exemple: Mme X participe à l'atelier A, C, F et G

:(:( Donc Mme X va figurer sur la feuille Familles, Feuille At_A, At_C, At_F et At_G.

Et voilà la fiche excel en pièces jointes pour mieux comprendre le problème

J'éspère que j'ai bien expliqué mon problème et merci pour votre aide d'avance
 

Pièces jointes

  • FAMILLES (Enregistré automatiquement) (Enregistré automatiquement).xlsm
    68.1 KB · Affichages: 87

Lone-wolf

XLDnaute Barbatruc
Bonjour stammy

Les données de recherche ne sont pas complètes. Il y a le nom de la feuille AtLinge, qui n'est pas correcte dans l'usf. Et, est-tu vraiment sur que Mme X participe à 4 ateliers en même temps??? Dans ce cas, il faut ajouter le(s) heure(s) de présence pour chaque atelier. À moins que, d'abord, tu découpe la dame en 4 morceaux :eek: oubien à la place de la combobox, mettre une listbox. Dans celle-ci tu sélectionne les ateliers et tu envois Mme X dans les différents ateliers.

Si elle refuse :mad:, c'est 3 mois de suspension de salaire. :D;)
 
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Re stammy

Un exemple. Mais il faut que tu renomme les Feuilles (Feuil1 à Feuil11). Il faut convertir les tableaux en plage avec ceci.

VB:
Private Sub rechbtn_Click()
Dim rPlage As Range, rCell As Range

With Sheets("liste adhérents").Range("a3:a10000")
Set rCell = .Find(txtrecherche, , xlValues, xlWhole)
If Not rCell Is Nothing Then
txtnom = rCell.Offset(0, 40)  'Rajoutée à la fin colonnes Nom et Prénom (manquantes)
txtprenom = rCell.Offset(0, 41)
txtdate = Format(CDate(Date), "dd.mm.yyyy")
Else
txtnom = ""
txtprenom = ""
txtdate = ""
MsgBox "Ce nom n'existe pas."
End If
End With
End Sub

Private Sub save_btn_Click()
Dim i As Long, lig As Integer

For i = 4 To ThisWorkbook.Sheets.Count
If presentbtn.Value = True Then
With Sheets(i)
lig = .Range("a65536").End(xlUp).Row + 1
.Cells(lig, 1).Value = txtnom.Value
.Cells(lig, 2).Value = txtprenom.Value
.Cells(lig, 3).Value = "Présent"
End With
End If

If absentbtn.Value = True Then
With Sheets(i)
lig = .Range("a65536").End(xlUp).Row + 1
.Cells(lig, 1).Value = txtnom.Value
.Cells(lig, 2).Value = txtprenom.Value
.Cells(lig, 3).Value = "Absent"
End With
End If
Next i
Unload Me
End Sub
 
Dernière édition:

stammy

XLDnaute Nouveau
Bonjour stammy

Les données de recherche ne sont pas complètes. Il y a le nom de la feuille AtLinge, qui n'est pas correcte dans l'usf. Et, est-tu vraiment sur que Mme X participe à 4 ateliers en même temps??? Dans ce cas, il faut ajouter le(s) heure(s) de présence pour chaque atelier. À moins que, d'abord, tu découpe la dame en 4 morceaux :eek: oubien à la place de la combobox, mettre une listbox. Dans celle-ci tu sélectionne les ateliers et tu envois Mme X dans les différents ateliers.

Si elle refuse :mad:, c'est 3 mois de suspension de salaire. :D;)

:D:D c'est forte ta réponse MDR
Merci comme même;
Mme X peut participer à 4 :pateliers différents ou + tout au long de la semaine donc pas besoin de la découper en morceau
 

stammy

XLDnaute Nouveau
Re stammy

Un exemple. Mais il faut que tu renomme les Feuilles (Feuil1 à Feuil11). Il faut convertir les tableaux en plage avec ceci.

VB:
Private Sub rechbtn_Click()
Dim rPlage As Range, rCell As Range

With Sheets("liste adhérents").Range("a3:a10000")
Set rCell = .Find(txtrecherche, , xlValues, xlWhole)
If Not rCell Is Nothing Then
txtnom = rCell.Offset(0, 40)  'Rajoutée à la fin colonnes Nom et Prénom (manquantes)
txtprenom = rCell.Offset(0, 41)
txtdate = Format(CDate(Date), "dd.mm.yyyy")
Else
txtnom = ""
txtprenom = ""
txtdate = ""
MsgBox "Ce nom n'existe pas."
End If
End With
End Sub

Private Sub save_btn_Click()
Dim i As Long, lig As Integer

For i = 4 To ThisWorkbook.Sheets.Count
If presentbtn.Value = True Then
With Sheets(i)
lig = .Range("a65536").End(xlUp).Row + 1
.Cells(lig, 1).Value = txtnom.Value
.Cells(lig, 2).Value = txtprenom.Value
.Cells(lig, 3).Value = "Présent"
End With
End If

If absentbtn.Value = True Then
With Sheets(i)
lig = .Range("a65536").End(xlUp).Row + 1
.Cells(lig, 1).Value = txtnom.Value
.Cells(lig, 2).Value = txtprenom.Value
.Cells(lig, 3).Value = "Absent"
End With
End If
Next i
Unload Me
End Sub


Re merci encore pour le code mais ça ne semble marché pourtant j'ai changé les noms des feuilles; quand je fais la recherche seule la date qui apparait et quand je remplis le formulaire il se passe rien.
Mais ça ne résoud pas mon problème: d'enregistrer les adhérents en même temps sur la "liste adhérents" et sur les tableaux des ateliers auxquels ils participent depuis le formulaire d'ajout.
 

Lone-wolf

XLDnaute Barbatruc
Bonjour Stammy,

c'est en mode code vba, dans la liste gauche qu'il faut rennomer les feuilles, et non en mode normal.

feuilles.gif
 

Lone-wolf

XLDnaute Barbatruc
Qu'est-ce que tu veux, je suis comme ça. :oops:

De Silkyroads:

VB:
Private Sub UserForm_Initialize()
    Dim j As Integer
 
    'Récupère les données de la colonne A...
    For j = 1 To Range("A65536").End(xlUp).Row
        ComboBox1 = Range("A" & j)
        '...et filtre les doublons
        If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem Range("A" & j)
    Next j
End Sub


Private Sub CommandButton1_Click()
    Dim i As Integer
    'Les index des Listbox commencent par zéro
    For i = 0 To ListBox1.ListCount - 1
        Debug.Print ListBox1.List(i)
    Next i
End Sub


Private Sub Listbox1_dblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim Cible As Integer
 
    On Error Resume Next
 
    With ListBox1
        If .ListIndex < 0 Then Exit Sub
        Cible = .ListIndex
        If Cible = 0 Then Exit Sub
     
        .AddItem .Text, Cible - 1
        .RemoveItem Cible + 1
        .Selected(Cible - 1) = True
    End With
End Sub

Wath Else?! :cool:

Et entre-nous tu as regardé le classeur exemple?! ;)
 

Staple1600

XLDnaute Barbatruc
Re

Et bien, tu viens de m'apprendre quelque chose de nouveau. Merci JM.
Le problème de mémoire est plus sérieux qu'il n'y parait, diantre! ;)
Bonjour Lone-Wolf

On peut aussi pour s'affranchir des versions Excel, utiliser plutôt:
lig = .Cells(Rows.Count,1).End(xlUp).Row + 1
ou selon les préfénce d'écriture
lig = .Range("A" & Rows.Count).End(xlUp).Row + 1
 

Lone-wolf

XLDnaute Barbatruc
Re JM,

Et comme ceci c'est correct?

VB:
With WsVProd
derlig = .Range("b" & Rows.Count).End(xlUp).Row
For j = 2 To derlig
.Range("d" & j) = Application.SumIf(WsDC.Range("d2:d65536"), .Range("b" & j), WsDC.Range("e2:e65536"))
Next j
End With

Ou

.Cells(lig, "A")   'par exemple

EDIT: Sorry pour le doublon, on c'est croisés.
 

Lone-wolf

XLDnaute Barbatruc
Re

J'ai édité mon message. Personnelement je préfère le 2ème, là au moins on vois de quelle colonne il s'agit;
.Cells(lig, 45) s'a oblige à utiliser le tabulateur pour voir de qu'elle colonne il sagit. À moins de mettre en commentaire le nom de la colonne.
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 909
Membres
101 836
dernier inscrit
karmon