Transposer des lignes dans une autre feuille Excel sous condition
Bonjour,
Je souhaiterais savoir s'il est possible d'alimenter des feuilles excel en fonction d'une autre de manière automatique et sous condition.
Voici mon projet : J'ai une feuille excel, que j'appelle base de données puisque celle-ci est assez dense (une cinquantaine de lignes). Dans la colonne B, appelée "Société", seules 3 valeurs sont possibles : Marseille, Lille ou Paris. A chacune de ces données correspond une feuille excel. De sorte, que j'ai 4 feuilles excel : la base de données, une feuille "Marseille", une feuille "Paris" et une feuille "Lille".
Je souhaiterais ainsi que toutes les lignes, par exemple contenant Marseille dans la colonne B, soient transposées dans la feuille "Marseille".
Existe-t-il un moyen simple ? Par exemple avec Relations ? Sinon je suis ouvert à la VBA. L'essentiel étant que dès lors que je modifie une donnée dans la base de données, la mise à jour s'effectue dans les autres feuilles excel.
Je vous joins une version simplifiée de mon tableau, avec des données autres car celles-ci sont confidentielles, mais le principe reste le même.
Merci infiniment pour votre aide !
Bonjour mm_b, le forum,
Un essai, par macro (que j'avais en stock et adaptée à ton fichier
Cordialement,
Bonjour,
Un essai avec des filtres.
Bonsoir,
Une autre proposition !?
Cdlt.
=FILTRE(CHOISIRCOLS(t_données;1;3;4;5;6);t_données[Société]=B1;"pas de données")Re
Ca fait un moment que je cherchais des filtres en choisissant les colonnes. Je ne connaissais pas cette fonction. Super!
Bonsoir à tous !
@Jean-Eric : La fonction CHOISIRCOLS a été "libérée" ?
La documentation Microsoft semble indiquer le contraire :
Re,
@JFL, je ne sais pas mais !
De toute façon, avec les différents canaux de distribution des mises à jour (mensuels, semi-annuels, etc), on va devoir se poser la question encore pendant plusieurs mois.
Alors, je prends le risque !
Cdlt.
Bonjour à tous
Oui sur dernière MAJ (révision 2209) on a eu pas mal de nouvelles fonctions
Bonsoir le fil, bonsoir le forum,
J'arrive bien en retard mais je poste quand même. Proposition VBA très similaire à celle de Xorsankukai mais l'action se produit à la sortie de l'onglet Base de données...
Le code :
Private Sub Worksheet_Deactivate() 'à la sortie de l'onglet
Dim TP As ListObject 'déclare la variabe TP (Tableau Principal)
Dim O As Worksheet 'déclare la variabe O (Onglet)
Dim TV As ListObject 'déclare la variabe TV (Tableau de la Ville)
Dim D As Object 'déclare la variabe D (Dictionnaire)
Dim I As Integer 'déclare la variabe I (Incrément)
Dim J As Integer 'déclare la variabe J (incrément)
Dim K As Integer 'déclare la variabe K (incrément)
Dim TMP As Variant 'déclare la variabe TMP (Tableau TeMPoraire)
Dim TL() As Variant 'déclare la variabe TL (Tableau des Lignes)
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set TP = Me.ListObjects(1) 'définit la tableau principal TP
Set D = CreateObject("Scripting.Dictionary") 'définit la dictionnaire D
For I = 1 To TP.ListRows.Count 'boucle sur toutes les lignes I du tableau principal TP
D(TP.DataBodyRange(I, 2).Value) = "" 'alimente le dictionnaire D avec les données en colonne 2 de TP (Ville)
Next I 'prochaine ligne de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments de TMP sans doublon (les clés)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments J du tableau temporaire TMP
K = 0: Erase TL 'réinitialise K, efface TL
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set O = Worksheets(TMP(J)) 'définit l'onglet O (génère une erreur si cet onglet n'existe pas)
If Err > 0 Then 'condition : si une erreur a été générée
Err.Clear 'supprime l'erreur
Worksheets.Add after:=Sheets(Sheets.Count) 'ajoute un onglet en dernière position
Set O = ActiveSheet 'définit l'onglet O
O.Name = TMP(J) 'renome l'onglet
O.ListObjects.Add(xlSrcRange, O.Range("$B$3:$F$4"), , xlYes).Name = "T" & TMP(J) 'ajoute un tableau structuré nommé tmp(J)
Set TV = O.ListObjects(1) 'définit le tableau de la ville TV
TV.HeaderRowRange(1, 1).Resize(1, 5) = Array("Projet", "Contact", "Téléphone", "Réponse", "Motif") 'alimente les en-têtes de TV
TV.TableStyle = "TableStyleMedium3" 'définit le style de TV
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set TV = O.ListObjects(1) 'définit le tableau de la ville TV
TV.DataBodyRange.Delete 'efface les données de TV
For I = 1 To TP.ListRows.Count 'boucle : 2 sur toutes les lignes de TP
If TMP(J) = TP.DataBodyRange(I, 2) Then 'condition : si l'élément J de TMP est égal à la donnée ligne I colonne 2 de TV (même ville)
K = K + 1 'incrémente K
ReDim Preserve TL(1 To 5, 1 To K) 'redimensionne TL (5 lignes, K colonnes)
TL(1, K) = TP.DataBodyRange(I, 1).Value 'récupère le projet dans la ligne 1 de TL
TL(2, K) = TP.DataBodyRange(I, 3).Value 'récupère le contact dans la ligne 2 de TL
TL(3, K) = TP.DataBodyRange(I, 4).Value 'récupère le téléphone dans la ligne 3 de TL
TL(4, K) = TP.DataBodyRange(I, 5).Value 'récupère la réponse dans la ligne 4 de TL
TL(5, K) = TP.DataBodyRange(I, 6).Value 'récupère le motif dans la ligne 5 de TL
End If 'fin de la condition
Next I 'prochaine ligne de la boucle 2
TV.Resize TV.Range.Resize(K, 5) 'redimensionne le tableau TV
TV.DataBodyRange(1, 1).Resize(K, 5).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé dans les données TV
Next J 'prochain élément de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End SubLe fichier :
Arf non !
Sur un forum j'ai découvert d'autres propositions intéressantes de fonctions, et ai mis à jour pour voir si je les avais
Là idem, j'ai regardé si j'avais CHOISIRCOLS
Mais je ne l'ai pas sur 2021 même révision...
Bonjour,
Pour information les 14 nouvelles fonctions Microsoft 365 sont actées depuis le 16 août 2022 pour le canal actuel avec la version 2208 (build 15601.20044).
J'ai pu le constater avec une réinstallation totale de Microsoft 365 (32bit).
Liste des fonctions :
Bonjour à tous !
Excellente nouvelle pour les non-Insider
Merci Jean-Eric.