Ventilation

Bonsoir à tous les membres de Excel-Pratique de vba,

Je viens une fois de plus vers vous car je suis completement noyé

j ai essayé tant bien que mal de composer un formulaire , et je vois bien que le chemin est encore tres long avant d'arriver à quelque chose de serieux,

pourtant aujourd'hui j en ai vraiment besoin pour mon travail.

dans le fichier qui est joint, vous pourrez voir qu'il y a 5 feuilles: FEMME, HOMME,AGE_15-25, AGE_25-30 et SOURCE.

je voudrais avoir des donnes dans les feuilles correspondants :

copier les plages de donnees de la feuille SOURCE (FEMME) dans la Feuille FEMME...

copier les plages de donnees de la feuille SOURCE (HOMME) dans la Feuille HOMME...

et ensuite suivant une condition qui pourra copiée mes donnes dans ma SOURCE en tranche d'AGE et les collés dans ma feuille correspondante

je vous remercie de l'attention que vous porterez à mon souci qui pour moi devient insurmontable.

bonne soirée à tous

15formulaire.xlsm (18.32 Ko)

Bonjour

Un essai à tester. Te convient-il ,

Bye !

8formulaire-v1.xlsm (34.84 Ko)

Bonjour,

je te retourne le fichier avec la macro à lancer manuellement, elle ventille bien tes données comme demandé, pour les tranches d'âge, j'ai fait selon moi, première: >=15 et <=25, deuxième: >25 et <=30.

Voici le résultat:

7formulaire.xlsm (25.10 Ko)

Bonjour gmb

Bonjour à tous

Quitte à passer par un filtre j'aurais utilisé le filtre avancé plus optimisé que le filtre auto...

Je pense même que c'est plus rapide que les array

Une autre solution par PowerQuery puisque Hlawson a 2016.

Il suffit d'utiliser Données, Actualiser tout pour mettre à jour.

J'ai pris pour ma part

>=15 et <25

>=25 et <= 30

A noter qu'on a des personnes en dessous de 15 mais personne de 25 et plus dans l'exemple fourni

Bonjour le fil, bonjour le forum,

J'arrive après la bagarre !... Comme j'ai commenté tout le code je me permets de proposer ma solution...

  • J'ai commencé par supprimer l'espace à la fin du nom de l'onglet "AGE_25-30 " qui est devenu "AGE_25-30".
  • Puis j'ai supprimé la ligne 1 de ce même onglet pour que les tableaux se situent tous au même niveau.
  • J'ai aussi modifié les tranches d'âge car elles ne me paraissaient pas cohérentes 15/25 et 26/30 (à adapter)...

Le code :

Option Explicit

Sub Macro1()
Dim OS As Worksheet, OH As Worksheet, OF As Worksheet, O1 As Worksheet, O2 As Worksheet 'déclare les variables OS, OH, OF, O1 et O2 (onglets)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TLH() As Variant, TLF() As Variant, TL1() As Variant, TL2() As Variant 'déclare les variables TLH, TLF, TL1 et TL2 (Tableaux de Lignes)
Dim KH As Integer, KF As Integer, K1 As Integer, K2 As Integer 'déclare les variables KH, KF,K1 et K2 (incréments)
Dim L As Byte 'déclare la variable L (incrément)

Set OS = Worksheets("SOURCE") 'définit l'onglet OS (Onglet Source)
Set OH = Worksheets("HOMME") 'définit l'onglet OH (Onglet Homme)
Set OF = Worksheets("FEMME") 'définit l'onglet OF (Onglet Femme)
Set O1 = Worksheets("AGE_15-25") 'définit l'onglet O1 (Onglet 15-25)
Set O2 = Worksheets("AGE_25-30") 'définit l'onglet O2 (Onglet 25-30)
TV = OS.Range("A3").CurrentRegion 'définit la tableau des valeurs TV
OH.Range("A3").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données de l'onglet OH
OF.Range("A3").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données de l'onglet OF
O1.Range("A3").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données de l'onglet O1
O2.Range("A3").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes données de l'onglet O2
KH = 1: KF = 1: K1 = 1: K2 = 1 'initialise les variables K
For I = 2 To UBound(TV, 1) 'boucle 1 sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 2) = "M" Then 'condition 1 : si la donnée ligne I colonne 2 de TV est égale à "M"
        ReDim Preserve TLH(1 To UBound(TV, 2), 1 To KH) 'redimensionne le tableau des lignes homme TLH (autant de lignes de TV a de colonnes, KH colonnes)
        For L = 1 To UBound(TV, 2) 'boucle 2 : sur toutes les colonnes L du tableau des valeurs TV)
            TLH(L, KH) = TV(I, L) 'récupère dans la ligne L de TLH la donnée en colonne L de TV (=> Transposition)
        Next L 'prochaine colonne de la boucle 2
        KH = KH + 1 'incrémente KH (ajoute une colonne au tableau des lignes homme TLH)
    End If 'fin de la condition 1
    If TV(I, 2) = "F" Then 'condition 1 : si la donnée ligne I colonne 2 de TV est égale à "F"
        ReDim Preserve TLF(1 To UBound(TV, 2), 1 To KF) 'redimensionne le tableau des lignes femme TLF (autant de lignes de TV a de colonnes, KF colonnes)
        For L = 1 To UBound(TV, 2) 'boucle 3 : sur toutes les colonnes L du tableau des valeurs TV)
            TLF(L, KF) = TV(I, L) 'récupère dans la ligne L de TLF la donnée en colonne L de TV (=> Transposition)
        Next L 'prochaine colonne de la boucle 3
        KF = KF + 1 'incrémente KF (ajoute une colonne au tableau des lignes femme TLF)
    End If 'fin de la condition 2
    If TV(I, 4) < 26 Then 'condition 3 : si la donnée ligne I colonne 4 de TV est inférieure à 26
        If TV(I, 4) <> "" Then 'condition 4 : si la donnée ligne I colonne 4 de TV n'est pas vide
            ReDim Preserve TL1(1 To UBound(TV, 2), 1 To K1) 'redimensionne le tableau des lignes 15-25 TL1 (autant de lignes de TV a de colonnes, K1 colonnes)
            For L = 1 To UBound(TV, 2) 'boucle 4 : sur toutes les colonnes L du tableau des valeurs TV)
                TL1(L, K1) = TV(I, L) 'récupère dans la ligne L de TL1 la donnée en colonne L de TV (=> Transposition)
            Next L 'prochaine colonne de la boucle 4
            K1 = K1 + 1 'incrémente K1 (ajoute une colonne au tableau des lignes 15-25 TL1)
        End If 'fin de la condition 4
    Else 'sinon (condition3 => si la donné ligne I colonne 4 est supérieure ou égale à 26
        If TV(I, 4) <> "" Then 'condition 4 : si la donnée ligne I colonne 4 de TV n'est pas vide
            ReDim Preserve TL2(1 To UBound(TV, 2), 1 To K2) 'redimensionne le tableau des lignes 25-30 TL2 (autant de lignes de TV a de colonnes, K2 colonnes)
            For L = 1 To UBound(TV, 2) 'boucle 5 : sur toutes les colonnes L du tableau des valeurs TV)
                TL2(L, K2) = TV(I, L) 'récupère dans la ligne L de TL2 la donnée en colonne L de TV (=> Transposition)
            Next L 'prochaine colonne de la boucle 5
            K2 = K2 + 1 'incrémente K2 (ajoute une colonne au tableau des lignes 25-30 TL2)
        End If 'fin de la condition 4
    End If 'fin de la condition 3
Next I 'prochaine ligne de la boucle 1
'si KH est supérieure à 1 renvoie dans A4 redimensionnée de l'onglet OH, le tableau TLH transposé
If KH > 1 Then OH.Range("A4").Resize(UBound(TLH, 2), UBound(TLH, 1)).Value = Application.Transpose(TLH)
'si KF est supérieure à 1 renvoie dans A4 redimensionnée de l'onglet OF, le tableau TLF transposé
If KF > 1 Then OF.Range("A4").Resize(UBound(TLF, 2), UBound(TLF, 1)).Value = Application.Transpose(TLF)
'si K1 est supérieure à 1 renvoie dans A4 redimensionnée de l'onglet O1, le tableau TL1 transposé
If K1 > 1 Then O1.Range("A4").Resize(UBound(TL1, 2), UBound(TL1, 1)).Value = Application.Transpose(TL1)
'si K2 est supérieure à 1 renvoie dans A4 redimensionnée de l'onglet O2, le tableau TL2 transposé
If K2 > 1 Then O2.Range("A4").Resize(UBound(TL2, 2), UBound(TL2, 1)).Value = Application.Transpose(TL2)
MsgBox "Données transférées !" 'message
End Sub

[Édition]

Je ne comprends pas pourquoi vous faites si simple alors qu'on peut faire si compliqué !... Honte à moi...

Le fichier :

Bonjour,

Une autre proposition Power Query.

Cdlt.

11formulaire.xlsm (44.64 Ko)

Mes remerciements a tous pour m'avoir donné la solution, je vous adore tous, vous tous formidable!

De rien!

on s'est jetés dessus comme si on avait faim

Merci d'avoir passé le sujet en résolu

Rechercher des sujets similaires à "ventilation"