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
 

Fichiers joints

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
Re

en PJ un classeur exemple. À partir de la Feuil2, double-clique sur la feuille. Effectue la recherche avec la combobox, sélectionne Présent ou Absent, puis sur Enregistrer.
 

Fichiers joints

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

Sauf que depuis SilkyRoads, Excel est passé au millions de lignes et plus, mister dodo ;)
C'est pourquoi on n'utilise plus
Range("A65536").End(xlUp).Row
mais
Cells(Rows.Count,1).End(xlUp).Row :D
 

Lone-wolf

XLDnaute Barbatruc
Et bien, tu viens de m'apprendre quelque chose de nouveau. Merci JM.

EDIT: voilà qui m'oblige à revoir mon projet pour y apporter ces modifications.
 
Dernière édition:

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.
 

Lone-wolf

XLDnaute Barbatruc
Bonjour JM, stammy :)

@ stammy: as-tu testé le classeur du post #7 ? Moi je n'ai eu aucun problème.

@JM : dans mon projet, j'ai modifier les lignes comme tu l'as dit et bizarrement les données trainent à l'enregistrement, en plus le titre du formulaire m'affiche un joli "UsfCommandes ne réponds pas" et obligé de fermé excel avec le gestionnaire.

J'ai aussi tester dans un classeur (quasiment vierge ;)) pour 10 feuilles en écrivant comme ceci

lig = sheets(i).UsedRange.Rows.count + 1

Mais est-ce aussi correct d'écrire ainsi?
 

stammy

XLDnaute Nouveau
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?! ;)
Oui j'ai vu le classeur mais il y a une errure
Bonjour JM, stammy :)

@ stammy: as-tu testé le classeur du post #7 ? Moi je n'ai eu aucun problème.

@JM : dans mon projet, j'ai modifier les lignes comme tu l'as dit et bizarrement les données trainent à l'enregistrement, en plus le titre du formulaire m'affiche un joli "UsfCommandes ne réponds pas" et obligé de fermé excel avec le gestionnaire.

J'ai aussi tester dans un classeur (quasiment vierge ;)) pour 10 feuilles en écrivant comme ceci

lig = sheets(i).UsedRange.Rows.count + 1

Mais est-ce aussi correct d'écrire ainsi?

Mince j'ai cru que j'ai envoyé la réponse ce matin!!
oui je l'ai testé et ça parait ce que je cherche :) sauf que pour la colonne des dates se rajoute automatiquement comme sur la photo ci-joint
 

Fichiers joints

Lone-wolf

XLDnaute Barbatruc
Re

C'est bizarre, je viens d'inserer une ligne dans mon classeur exemple, tout est ok.

EDIT: je sais pourquoi ça inscrit la date en première ligne. Il faut que tu convertisse les tableaux en plages normales.
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonsoir à tous

LoupSolitaire
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
Pour ma part, j'éviterai la boucle et écrirai la chose ainsi
VB:
Sub b()
Dim derlig As Long
derlig = Feuil1.Range("b" & Rows.Count).End(xlUp).Row
    With Feuil1.Range("D2:D" & derlig)
        .FormulaR1C1 = "=SUMIF(Feuil2!RC:R[8]C,Feuil1!RC[-2],Feuil2!RC[1]:R[8]C[1])"
        .Value = .Value
    End With
End Sub
 
Dernière édition:

Discussions similaires


Haut Bas