Discussion :

[PLJerem]

Bonjour,

Pour vous expliquer mon problème j'ai simplifié sous la forme de l'exemple suivant : j'ai un classeur qui contient 3 feuilles différentes :
- Feuille "Mixte" (qui contient toutes les personnes)
- Feuille "Hommes" qui contient que les personnes du sexe Masculin
- Feuille "Femmes" qui contient que les personnes du sexe Féminin

Toute la saisie se fait sur la feuille "Mixte" :

Nom	Prénom	Sexe
DUPOND	Georges	Homme
DUBOIS	Raymonde	Femme

Je souhaite que ma macro "trieSexe" dispatche les personnes "Homme" sur la feuille "Hommes" et les personnes "Femme" sur la feuille "Femmes"

J'ai donc créé sur un bouton sur la feuille "Mixte" qui permet de lancer la macro "trieSexe".

Ma macro "trieSexe" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 
Sub trieSexe()
    Dim iLineInProgress As Integer ' Ligne en cours d'analyse
    Dim SheetMixte As Worksheet ' Feuille contenant toutes les personnes
    Dim SheetDest As Worksheet ' Feuille de destination de la personne "Hommes" ou "Femmes"
    Dim derLigneMixte As Integer ' Dernière ligne de la feuille "Mixte"
    Dim derLigneDest As Integer 'Dernière ligne de la feuille "Hommes" ou "Femmes" en fonction du trie
    Dim sexe As String ' Contenu de la colonne "Sexe" de la ligne en cours d'analyse
 
    Set SheetMixte = Worksheets("Mixte") ' Définition de la feuille contenant toutes les personnes "Mixte"
 
    derLigne = SheetMixte.Range("A2").CurrentRegion.End(xlDown).Row ' Détermination du numéro de la dernière ligne de la feuille "Mixte"
 
    ' Lecture ligne par ligne de la feuille "Mixte"
    For iLineInProgress = 2 To derLigne
        ' Traitement de la ligne en fonction de son Sexe (colonne Sexe)
        sexe = Sheets("Mixte").Cells(iLineInProgress, 3)
 
        Select Case (sexe)
            ' Si c'est un homme
            Case Is = "Homme"
                Set SheetDest = Worksheets("Hommes") ' Définition de la feuille destination
                derLigneDest = SheetDest.UsedRange.Rows.Count + 1 ' Détermination du numéro de la dernière ligne de la feuille destination
                SheetMixte.Range(iLineInProgress & ":" & iLineInProgress).Copy SheetDest.Range(derLigneDest & ":" & derLigneDest) ' Copie de la ligne entière vers le bon onglet
 
            ' Si c'est une femme
            Case Is = "Femme"
                Set SheetDest = Worksheets("Femmes") ' Définition de la feuille destination
                derLigneDest = SheetDest.UsedRange.Rows.Count + 1 ' Détermination du numéro de la dernière ligne de la feuille destination
                SheetMixte.Range(iLineInProgress & ":" & iLineInProgress).Copy SheetDest.Range(derLigneDest & ":" & derLigneDest) ' Copie de la ligne entière vers le bon onglet
 
            ' Sinon
            Case Else
                ' On ne devrait jamais y être
 
        End Select
    Next
End Sub

Ici l'exemple utilisé est simple est fonctionne très bien.
Dans mon projet j'ai une quinzaine de "Case" et j'ai des lignes de ma feuille de saisie qui peuvent être copier sur plusieurs feuilles en même temps.

Je suis débutant en VBA, pour simplifier le fonctionnement je pense qu'une fonction pourrait faire le travail dans mon Select :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Case Is = "condition 1"
        AddLineToSheet("feuille de destination 3")
        AddLineToSheet("feuille de destination 8")
 
Case Is = "condition 2"
        AddLineToSheet("feuille de destination 1")

Là je bloque, je n'ai pas encore l'aisance naturelle dans VBA pour créer une telle fonction (nouveau "Module", nouvelle fonction "Function AddLineToSheet("Feuille"), où placer ma fonction, etc.)

Pourriez vous me guider ? Je vous remercie

[zipbox]

Bonjour,

avec 2 conditions, "if...then...else" va bien :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
  If (Sexe = "condition 1") Then
    '
    AddLineToSheet ("feuille de destination 1")
    '
  ElseIf (Sexe = "condition 2") Then
    '
    AddLineToSheet ("feuille de destination 2")
    '
  Else
    '
  End If

[PLJerem]

Ahhhhhh pardon je n'ai pas été clair !

C'est la fonction "addLineToSheet" que je ne sais pas faire.

Est ce que je la laisse dans le même module où je créé un autre module pour la stocker dedans?

Vaut-il mieux partir sur "fonction" ou sur "sub" ?
J'ai fait des essais, mais toujours sans succès.

[Menhir]

Vaut-il mieux partir sur "fonction" ou sur "sub" ?

Pour simplifier, un Sub réalise une action et une Function renvoie une valeur.
Il semble donc évident que pour ton application, c'est un Sub qui est adapté.

J'ai fait des essais, mais toujours sans succès.

Tu devrais montrer ce que tu as tenté, ce serait une base d'étude.

[zipbox]

Re Bonjour,

et milles excuses . . .

voici mon exemple de code, à adapter . . .

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
Sub TrieColonne_C()
  '
  ' Colonne 1 : Nom
  ' Colonne 2 : Prénom
  ' Colonne 3 : Sexe
  '
  Const f1 As String = "Mixte"
  Const f2 As String = "Hommes"
  Const f3 As String = "Femmes"
  '
  Dim i As Integer
  Dim n1 As Integer, n2 As Integer, n3 As Integer
  '
  n1 = 0: n2 = 0: n3 = 0
  '
  For i = 2 To (Sheets(f1).Cells(Rows.Count, 1).End(xlUp).Row)
    '
    ' MsgBox Cells(i, 1).Value & " " & Cells(i, 2).Value & " " & Cells(i, 3).Value
    '
    n1 = n1 + 1
    '
    If (UCase(Sheets(f1).Range("C" & i).Value) = "HOMME") Then
      n2 = n2 + 1
      Sheets(f2).Range("A" & (n2 + 1) & ":C" & (n2 + 1)).Value = Sheets(f1).Range("A" & i & ":C" & i).Value
    End If
    '
    If (UCase(Sheets(f1).Range("C" & i).Value) = "FEMME") Then
      n3 = n3 + 1
      Sheets(f3).Range("A" & (n3 + 1) & ":C" & (n3 + 1)).Value = Sheets(f1).Range("A" & i & ":C" & i).Value
    End If
    '
  Next i
  '
  MsgBox n1 & " : ligne(s)" & vbCrLf & _
         n2 & " : Homme(s) " & vbCrLf & _
         n3 & " : Femme(s) "
 
  '
End Sub

[Marc-L]

Bonjour,

rappel :   plus efficace qu'une boucle ligne à ligne est la copie globale via un filtre ou un filtre avancé …

___________________________________________________________________________________________________________

Je suis Paris, Egypte, Nigeria, New-York, Mogadicio, Barcelone, London, Manchester, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …