Macro qui crée une ligne chaque fois que valeur de colonne = VRAI

**CaroBibb** · 23/09/2016, 17h44

Bonjour,
Je n'ai pas trouvé sur les autres discussions la réponse à mon blocage... Je suis un peu rouillée, je ne fais pas souvent des macros et je me retrouvée bloquée dans celle-ci.

Mon besoin est le suivant, j'ai un onglet "Formulaires" qui est une extraction de formulaires Infopath. Dans ce formulaire, il y a plusieurs cases à cocher, une fois extraite dans Excel, je me retrouve avec une colonne par case avec la valeur VRAI lorsqu'elle a été cochée et FAUX dans le cas contraire.

J'ai donc un ligne par employé dans mon onglet "Formulaires" et pour mon fichier de chargement, je dois avoir une ligne par Employé+case cochée. Je veux donc que ma macro recherche la valeur VRAI dans un range de colonnes de l'onglet "Formulaires" et si elle trouve, elle inscrit dans mon onglet "Chargement" l'en-tête de la colonne où le VRAI a été coché AINSI que la date et le NoEmployé. Et passe à la prochaine Valeur VRAI de cette même ligne et recommence jusqu'à ce qu'il n'y ait plus de VRAI dans cette ligne. Une fois cette ligne terminée, il refait cette recherche dans la ligne suivante de l'onglet "Formulaires", jusqu'à la dernière ligne.

J'ai débuté ma macro et j'ai fait mon "plan", mais je ne réussis pas à trouver comment faire.

Est-ce que vous avez de l'aide à m'offrir SVP

PS J'ai mis le document en PJ

Merci

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub Squelette()
'
' Squelette Macro
'
 
 
 
 
 
'Définir la premiere ligne ou se trouve la donnée de l'onglet Formulaire
'****************************************************************************************************************************
'***********************ÉTAPE 1 (Action à faire pour une ligne)**************************************************************
'****************************************************************************************************************************
 
 
'1A) Action Annulée
 
'1B)   Dans l'onglet "Formulaire", Trouver la première cellule entre colonne H et FH où c'est écrit VRAI.
        Sub Cherche()
 
        Dim Trouve As Range, PlageRecherche As Range
        Dim ValeurRecherchee As String
 
        ValeurRecherchee = "VRAI"
        Set PlageRecherche = Sheets("Formulaires").Rows("1:1")
        Set Trouve = PlageRecherche.Cells.Find(What:=ValeurRecherchee, LookAt:=xlWhole)
 
        If Trouve Is Nothing Then
        'Ici je veux inscrire que s'il ne trouve pas, qu'il passe à l'étape 2
 
        Else
 
        'ici je veux dire que s'il trouve, qu'il passe à l'étape 1C, 1D, 1E
 
        End If
 
        Set PlageRecherche = Nothing
        Set Trouve = Nothing
 
        End Sub
 
 
   'Ici je bloque :
'1C)       Lorsque le contenu de la cellule = "VRAI", inscrire la valeur de l'en-tête de cette colonne dans l'onglet "Chargement" de la colonne D (Division)
 
 
'1D)       Copier la valeur de la colonne C (Matricule) de l'onglet "Formulaire" vers l'onglet "Chargement" de la colonne A (Matricule) à la prochaine ligne dispo)
'1E)       Copier la valeur de la colonne F (Date) de l'onglet "Formulaire" vers l'onglet "Chargement" de la colonne B (Date) à la prochaine ligne dispo)
 
'REFAIRE CETTE ACTION JUSQU'À LA DENRIÈRE COLONNE (FH)DE CETTE LIGNE (UNE LIGNE PAR EMPLOYÉ)
 
 
'********************************************************************************************************************************
'***********************ÉTAPE 2 (Passer à la ligne suivante)*****************************************************************
'********************************************************************************************************************************
 
'2A)        Aller à la ligne suivante de l'onglet "Formulaire"
'2B)        Refaire les étapes 1B à 1E l'étape
'2C)        Terminer lorsque la dernière ligne est atteinte
 
 
 
 
End Sub

Caro

**Stanler** · 23/09/2016, 18h01

Bonjour,

Tu as la bonne méthode en tout cas : Le squelette c'est comme ça qu'il faut faire.

Voici de la lecture :

Les boucles expliquées par Silkyroad
Topic sur If
Cours général avec focus sur "If"

Ca devrait te débloquer normalement.

Pour le c/c, privilégie autant que possible les :

Code :

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

Range("A1") = Range("B2")

, ça permet de "copier" la valeur de la cellule B2 et de la "coller" dans la cellule A1... Sans c/c

Have fun

**CaroBibb** · 26/09/2016, 16h28

J'ai finalement changé de tactique et voici mon nouveau codage, j'ai quelque part un erreur dans mon Next/For, je cherche quelle est mon erreur...

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
   Sub Looping()
 
        Dim LigneDestination As Long  'declare la variable LigneVide (ligne)
        Dim ColonneEntete As Long 'Declare la variable de l'onglet formulaire
        Dim DerniereLigne As Long 'Declare la variable de l'onglet formulaire
        Dim LigneRecherche As Integer 'Declare la variable de l'onglet formulaire
        Dim ColonneRecherche As Integer 'Declare la variable de l'onglet formulaire
 
        LigneDestination = Sheets("Chargement").Cells(Application.Rows.Count, 1).End(xlUp).Row + 1
        ColonneEntete = Sheets("Formulaires").Rows("1:1")
        DerniereLigne = Sheets("Formulaires").Cells(Application.Rows.Count, 3).End(xlUp).Row
        LigneRecherche = 2
        'ColonneRecherche =  Colonnes 8 to 164
 
        'Instruction pour continuer jusqu'à la dernière ligne
        For LigneRecherche = 2 To DerniereLigne
        LigneRecherche = LigneRecherche + 1
 
        For ColonneRecherche = 8 To 164
 
        'Lorsque l'on trouve un VRAI dans le contenu de la cellule
 
        If Cells(LigneRecherche, ColonneRecherche).Value = VRAI Then
             Sheets("Chargement").Cells(LigneDestination, 1).Value = Sheets("Formulaires").Cells(LigneRecherche, 3)
             Sheets("Chargement").Cells(LigneDestination, 2).Value = Sheets("Formulaires").Cells(LigneRecherche, 6)
             Sheets("Chargement").Cells(LigneDestination, 4).Value = Sheets("Formulaires").Cells(ligneentete, ColonneRecherche)
 
        'REFAIRE CETTE ACTION JUSQU'À LA DERNIÈRE COLONNE (FH)DE CETTE LIGNE (UNE LIGNE PAR EMPLOYÉ)
                Next ColonneRecherche
 
        'Lorque toutes les valeurs des colonnes 8 à 164 ont été vérifié, changer de ligne
 
                Next LigneRecherche
 
 
        End Sub

**Stanler** · 26/09/2016, 16h37

Tu as une erreur ? Sur quelle ligne ?

Est ce que le code s'exécute comme tu le souhaites jusqu'à l'erreur ?

Pour "trouver" une valeur, tu peux utiliser ".find"

Que est ce que ça donne si tu essayes d'exécuter le code avec le mode "pas à pas" (touche F8) ?