XL 2013 Association Tableau récapitulatif membres + Fiches perso

[YANOU38]

Bonjour le Forum,
J'ai récupéré ce code et essayé de le modifier...
Il permet, à partir du tableau de la Feuille "Base", de créer une Feuille par membre (en cliquant sur "Mise à jour")
Mon 1ier problème :
J'ai ajouté une ligne (sur "Base") pour mettre un titre à mon Tableau ""Saison 2021 - 2022".
Depuis, cela me créer une Feuille vierge "-" juste avant la Feuille "Modèle".
Comment y remédier ?
Mon 2ième problème :
J'ai ajouté une colonne K (sur "Base") "Réglé le", mais je n'arrive pas à ajouter la prise en compte de cette colonne dans la macro.
J'ai tenté un

Array("Réglé le", "Réglé le :", "B12") _

vers le début du code, mais cela ne fonctionne pas.
J'ai tenté d'augmenter le nombre de champs "NChp", mais rien n'y fait, je ne dois pas m'y prendre correctement.

Le but étant de pouvoir rajouter une dizaine de colonnes (Adresse + Mail + ...) au tableau sur la Feuille "Base".

Merci pour votre aide.

 

[Compte Supprimé 979]

Bonjour Yanou38

Qui t'as construit cette formule pour définir ta plage de données 😱

=DECALER(Base!$B$2;;;MAX((DECALER(Base!$B$2;;;NEnr;1)<>"")*LIGNE(DECALER(Base!$2:$2;;;NEnr;)));MAX((DECALER(Base!$B$2;;;;NChp)<>"")*COLONNE(DECALER(Base!$B:$B;;;;NChp))))

Sinon à part être sur une très vieille version d'Excel, pourquoi ne pas utiliser un tableau structuré ?

A+

 

[YANOU38]

Bonjour BrunoM45, le Forum,
J'ai récupéré ce code sur Excel Downloads, il marchait très bien avant que je décide d'y mettre les pattes. 😉
Je ne connaissais pas les Tableaux structurés (je viens d'aller y jeter un coup d'oeil).
Si je n'ai pas d'autres réponses, je tenterai d'utiliser cette solution.
Merci pour votre aide.

 

[Compte Supprimé 979]

Re,

Voici le fichier au format ".xlsm", le code modifié et avec un tableau structuré 😉

A toi de voir

Nota : Si l'envie te prenait, je ne teste pas le nombre de ligne vide. Un TS ce doit d'être sans, cela ne sert à rien.

A+

 

[YANOU38]

Re,
Wahou ! 😛
Par contre pour la prise en compte de la colonne K "Réglé le" (et les futurs autres colonnes) ?
Si je peux, est-il possible de ranger automatiquement les Noms par ordre alphabétique ?
Merci pour ton aide

 

[YANOU38]

Le Filtre sur les noms marche très bien pour l'ordre alphabétique (quel pitre) ...🙄

 

[Compte Supprimé 979]

Re,

Pour les futures colonnes, il suffit de les ajouter au code dans le ARRAY()

Avant la dernière parenthèse fermante, ajouter une virgule + espace + tiret bas
et à la ligne on ajoute

Array("Réglé le", "Réglé le :", "B11"))

sans oublier la dernière parenthèse fermante

Ensuite, le code est fait en sorte que tout est auto

J'espère que ce sera clair pour toi 🤔

A+

 

[YANOU38]

Re,
J'ai un "Base inadéquate" qui apparait ?
Merci pour ton aide.

 

[Compte Supprimé 979]

Re,

C'est la colonne "Tarif à l'année" qui pose problème effectivement et c'est une cellule qu'on ne remplit pas à priori dans le modèle 🤔

Il faut soit la sauter, soit mettre une cellule fictive

A+

 

[YANOU38]

Bonjour BrunoM45,
Je vois de mon côté pour essayer d'élucider ce problème.
Merci encore d'avoir pris du temps pour moi.
Je reviens sur le forum si j'ai du nouveau.

 

[Compte Supprimé 979]

Re,

Pour mieux que tu comprennes mon idée, voici le code auquel je pensais

Tu verras que "Tarif à l'année " fait référence à une cellule extérieures à ton masque J12

Sub Toto()
  Dim i&, j&, ind$, tmp$, Chp(), oSh(), oKeys(), oItms(), oDt As Scripting.Dictionary
  Dim LObj As ListObject
  'correspondance des champs des feuilles "base" et "Modele", DANS L'ORDRE DES CHAMPS DE "base".
  Chp = Array( _
        Array("NOM", "Nom : ", "B4"), _
        Array("Prénom", "Prénom : ", "B5"), _
        Array("Propriété", "Propriété : ", "B6"), _
        Array("Instrument", "Instrument : ", "B7"), _
        Array("Marque", "Marque :", "B8"), _
        Array("Type", "Type :", "B9"), _
        Array("N°", "N° :", "B10"), _
        Array("Choix option", "Choix option :", "B11"), _
        Array("Tarif à l'année", "Tarif à l'année : ", "J12"), _
        Array("Réglé le", "Réglé le :", "B12"))
  ' Définition du tableau structuré
  Set LObj = Sheets("Base").ListObjects("Tableau1")
  ' Vérifier si des lignes existes
  If LObj.ListRows.Count = 1 Then Exit Sub       'Rien à traiter
  ' Vérifier l'ordre des champs
  For i = 0 To UBound(Chp)
    If Chp(i)(0) <> LObj.HeaderRowRange.Cells(1, 1 + i) Then MsgBox ("Base inadéquate"): Exit Sub 'Base inadéquate.
  Next
  'Ventilation de la base par onglet :
  Set oDt = CreateObject("Scripting.Dictionary")
  For i = 1 To LObj.ListRows.Count               ' De la première ligne de données à la dernière
    With LObj.DataBodyRange
      ind = .Cells(i, 1) & "_" & .Cells(i, 2)
      tmp = ""
      Do While oDt.Exists(ind & tmp): tmp = " " & CStr(Val(tmp) + 1): Loop 'Gestion des homonymies.
      oDt.Add ind & tmp, Array(ind & tmp, .Rows(i).Value)
    End With
  Next
  'Répertoire des feuilles existantes :
  ReDim oSh(1 To Sheets.Count)
  For i = 1 To Sheets.Count: oSh(i) = Sheets(i).Name: Next
  '
  'création/mise à jour des onglets :
  oKeys = oDt.Keys
  With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
  For i = 0 To oDt.Count - 1
    For j = 1 To UBound(oSh)
      If oKeys(i) = oSh(j) Then Exit For
    Next j
    If j > UBound(oSh) Then                      'Nouvelle feuille
      Worksheets("Modele").Copy Before:=Worksheets("Modele")
      ActiveSheet.Name = oKeys(i)
    Else                                         'Feuille existante
      Worksheets(oKeys(i)).Activate
    End If
    oItms = oDt(oKeys(i))(1)
    For j = 0 To UBound(Chp): ActiveSheet.Range(Chp(j)(2)) = oItms(1, j + 1): Next
    Call Masque
  Next i
  Sheets("Base").Activate
  With Application: .EnableEvents = 1: .Calculation = -4105: .ScreenUpdating = 1: End With
  Set oDt = Nothing: Erase Chp(), oSh(), oKeys(), oItms()
End Sub

A+

 

[YANOU38]

Re,
Et du coup pour y remédier ?

 

[Compte Supprimé 979]

Re,

Utiliser le code que j'ai donné au post #11 🤣

 

[YANOU38]

Re,
je tombe sur une "Erreur de compilation - Sub ou Function non définie"
Merci pour ton aide.

 

[Compte Supprimé 979]

Re,

Sérieux Yanou38 🤨 🙄

Ce message s'arrête à quel endroit et quelle ligne est surlignée !?

Dans votre fichier d'origine, vous avez une Sub Masque() qu'il ne faut pas supprimer, à moins qu'elle ne vous serve à rien !?
Auquel cas il faut également supprimer la ligne en question