Programmation complexe de saisie

Version imprimable

08/07/2017, 16h48
Kris41

1 pièce(s) jointe(s)

Programmation complexe de saisie

Bonjour à tous,

J'ai besoin d'aide pour programmer ce que je voudrais faire pour automatiser la saisie des informations pour mon boulot.

Dans un premier temps je voudrais programmer la copie automatique de la saisie des différentes informations de la première feuille "validation BC" sur l'avant dernière feuille "synthèse en cours".

Dans un deuxième temps, je voudrais que quand je saisie la "Date du BC" sur la première feuille, celle-ci se désactive, et activer la deuxième feuille "Edition BC" pour continuer la saisie, sachant que mon rapport entre toutes les feuilles sera le n° de bon de commande. Donc programmer la copie automatique de la saisie de la deuxième feuille "Edition BC sur l'avant dernière feuille "synthèse en cours". Et supprimer la ligne de la première feuille "validation BC" car celle-ci est passé sur la deuxième feuilles.

J'espère être clair dans mes explications et que cela est possible.

Je vous remercie par avance de toute l'aide que vous pourrez me fournir.

Cordialement.Pièce jointe 292519

Suite

Pour le moment je bloque sur ce code.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim DernLign As Long, i&, LignCible
 
derlign = .Range("A" & .Rows.Count).End(xlUp).Row
LigneCible = 4
For i = 5 To derlign
If .Range("O" & i) <> "" Then
Sheets("Edition BC").Activate
.Range("C" & i).Copy Sheets("EDITION BC").Range("A" & LignCible)
.Range("D" & i).Copy Sheets("EDITION BC").Range("B" & LignCible)
.Range("O" & i).Copy Sheets("EDITION BC").Range("C" & LignCible)
LigneCible = LigneCible + 1
End If
Next
 
End Sub

09/07/2017, 21h00
QuestVba
Bonsoir,

Que veux-tu dire par :

Citation:

Envoyé par Kris41

Pour le moment je bloque sur ce code.
- Il y a une erreur ?
- Il ne fait pas ce que tu désires ?
- ...
09/07/2017, 21h34
Kris41

1 pièce(s) jointe(s)

Bonjour,

Le code fait bien ce que je veux le seule soucis c'est que j'utilise des tableaux insérés donc il fait une partie de ce que je veux. J'essai de l'adapter sur les tableaux insérés mais je peine beaucoup.

Voici le classeur en question mis à jour si on peut dire ainsi.

Bonsoir à tous,

J'ai un peu progressé dans ce que je voulais faire mais je n'obtiens pas encore l'effet désiré, voici le code :

Code:

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
Private Sub CommandButton1_Click()
 
Dim TableauValidationBC() As String
Dim l As Integer
Dim DernLign As Long, i&, LignCible
Dim Table1, Table2 As ListObjects
 
Set Table1 = ThisWorkbook.Worksheets("VALIDATION BC").ListObjects("TableauValidationBC")
 
        With Table1
 
        DernLign = Range("A" & Rows.Count).End(xlUp).Row
        LignCible = 6
 
            For i = 6 To DernLign
                If Range("N" & i) = "OUI" Then
 
                Range("C" & i).Copy Sheets("EDITION BC").Range("A" & LignCible)
                Range("D" & i).Copy Sheets("EDITION BC").Range("B" & LignCible)
                Range("A" & i).Copy Sheets("SYNTHESE EN COURS").Range("A" & LignCible)
                Range("B" & i).Copy Sheets("SYNTHESE EN COURS").Range("B" & LignCible)
                Range("C" & i).Copy Sheets("SYNTHESE EN COURS").Range("C" & LignCible)
                Range("D" & i).Copy Sheets("SYNTHESE EN COURS").Range("D" & LignCible)
                Range("E" & i).Copy Sheets("SYNTHESE EN COURS").Range("E" & LignCible)
                Range("F" & i).Copy Sheets("SYNTHESE EN COURS").Range("F" & LignCible)
                Range("G" & i).Copy Sheets("SYNTHESE EN COURS").Range("G" & LignCible)
                Range("H" & i).Copy Sheets("SYNTHESE EN COURS").Range("H" & LignCible)
                Range("I" & i).Copy Sheets("SYNTHESE EN COURS").Range("I" & LignCible)
                Range("J" & i).Copy Sheets("SYNTHESE EN COURS").Range("J" & LignCible)
                Range("K" & i).Copy Sheets("SYNTHESE EN COURS").Range("K" & LignCible)
                Range("L" & i).Copy Sheets("SYNTHESE EN COURS").Range("L" & LignCible)
                Range("M" & i).Copy Sheets("SYNTHESE EN COURS").Range("M" & LignCible)
                LignCible = LignCible + 1
 
                Range("A" & i).EntireRow.Delete
 
                Sheets("Edition BC").Activate
 
                End If
            Next
 
        End With
 
l = 39
 
ReDim TableauValidationBC(l)
 
End Sub

J'espère vraiment arriver à corriger les petits problème que je rencontre, car actuellement il me copie tout les données sans exception dans la feuille "synthese en cours", et oublie certaine données en copiant dans la feuille "Edition BC".

Si vous avez des suggestion, je suis preneur.

Cordialement.

11/07/2017, 20h06
Kris41

1 pièce(s) jointe(s)

Je met le fichier à dispo si besoin.Pièce jointe 293206

1 pièce(s) jointe(s)

Bonsoir,

Je pense avoir progresser un peu mais je bloque sur la fonction de suppression de ligne. Voici le code :

Code:

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
65
66
67
68
69
70
 
Private Sub CommandButton1_Click()

Dim WsE1 As Worksheet, WsSC3 As Worksheet
Dim DebLign As Long
Dim FinLign As Long
Dim Lign As Long
Dim NbSupLign As Long
Dim SupLign As Boolean
Dim i&, iC&, DernLign&, LignCible&

Set WsE1 = Sheets("EDITION BC")
Set WsSC3 = Sheets("SYNTHESE EN COURS")

DernLign = Range("A" & Rows.Count).End(xlUp).Row
LignCible = 6

    'Je boucle sur les lignes
    For Lign = FinLign To DebLign
    
        'pour la ligne en cours je désactive la posibilité de la suppression
        SupLign = False
   
                For i = 6 To DernLign
                    
                    'Si ma cellule contient le mot : OUI
                    If Range("N" & i) = "OUI" Then
                    'J'active la possibilité de suppression
                    SupLign = True
                    'Je copie mes valeurs dans le tableau suivant
                    Range("C" & i).Copy WsE1.Range("A" & LignCible)
                    Range("D" & i).Copy WsE1.Range("B" & LignCible)
                    'Je copie toutes les valeurs pour mon historique
                    Range("A" & i).Copy WsSC3.Range("A" & LignCible)
                    Range("B" & i).Copy WsSC3.Range("B" & LignCible)
                    Range("C" & i).Copy WsSC3.Range("C" & LignCible)
                    Range("D" & i).Copy WsSC3.Range("D" & LignCible)
                    Range("E" & i).Copy WsSC3.Range("E" & LignCible)
                    Range("F" & i).Copy WsSC3.Range("F" & LignCible)
                    Range("G" & i).Copy WsSC3.Range("G" & LignCible)
                    Range("H" & i).Copy WsSC3.Range("H" & LignCible)
                    Range("I" & i).Copy WsSC3.Range("I" & LignCible)
                    Range("J" & i).Copy WsSC3.Range("J" & LignCible)
                    Range("K" & i).Copy WsSC3.Range("K" & LignCible)
                    Range("L" & i).Copy WsSC3.Range("L" & LignCible)
                    Range("M" & i).Copy WsSC3.Range("M" & LignCible)
                    
                    'Je change de ligne
                    LignCible = LignCible + 1
                    'J'active mon deuxième tableau
                    WsE1.Activate
                    End If
           
                    'Si précédemment j'ai activé la possibilité de suppression
                    If SupLign = True Then
                    'Je supprime ma ligne
                    Rows(Lign & ":" & Lign).Delete Shift:=xlUp
                    'Et je remonte sur la ligne supprimer car la ligne 7 si supprimer devient la ligne 6
                    Lign = Lign - 1
                    
                        'Si le total des lignes examiner correspoond au nombre de ligne dans mon tableau j'arrete l'examen
                        If (Lign + NbSupLign) >= FinLign Then Exit For
                    End If
                    
                Next
                
    'Je passe à la ligne suivante
    Next Lign
       
End Sub

J'ai souligné la ligne sur laquelle je suis bloqué. Si quelqu'un a une idéé...

Merci pour le coup de main.

Cordialement.

Pièce jointe 294138

Bonjour,
3 commentaires sur ton code :
1. Ceci :

Code:

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
For i = 6 To DernLign
 
                    'Si ma cellule contient le mot : OUI
                    If Range("N" & i) = "OUI" Then
                    'J'active la possibilité de suppression
                    SupLign = True
                    'Je copie mes valeurs dans le tableau suivant
                    Range("C" & i).Copy WsE1.Range("A" & LignCible)
                    Range("D" & i).Copy WsE1.Range("B" & LignCible)
                    'Je copie toutes les valeurs pour mon historique
                    Range("A" & i).Copy WsSC3.Range("A" & LignCible)
                    Range("B" & i).Copy WsSC3.Range("B" & LignCible)
                    Range("C" & i).Copy WsSC3.Range("C" & LignCible)
                    Range("D" & i).Copy WsSC3.Range("D" & LignCible)
                    Range("E" & i).Copy WsSC3.Range("E" & LignCible)
                    Range("F" & i).Copy WsSC3.Range("F" & LignCible)
                    Range("G" & i).Copy WsSC3.Range("G" & LignCible)
                    Range("H" & i).Copy WsSC3.Range("H" & LignCible)
                    Range("I" & i).Copy WsSC3.Range("I" & LignCible)
                    Range("J" & i).Copy WsSC3.Range("J" & LignCible)
                    Range("K" & i).Copy WsSC3.Range("K" & LignCible)
                    Range("L" & i).Copy WsSC3.Range("L" & LignCible)
                    Range("M" & i).Copy WsSC3.Range("M" & LignCible)
 
                    'Je change de ligne
                    LignCible = LignCible + 1
                    'J'active mon deuxième tableau
                    WsE1.Activate
                   End If

est équivalent à :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
For i = 6 To DernLign
 
                    'Si ma cellule contient le mot : OUI
                    If Range("N" & i) = "OUI" Then
                        'J'active la possibilité de suppression
                        SupLign = True
                        'Je copie mes valeurs dans le tableau suivant
                        Range("C" & i & "D" & i).Copy WsE1.Range("A" & LignCible)
                        'Je copie toutes les valeurs pour mon historique
                        Range("A" & i & ":M" & i).Copy WsSC3.Range("A" & LignCible)                    
                        'Je change de ligne
                        LignCible = LignCible + 1
                        'J'active mon deuxième tableau
                        WsE1.Activate  '<--------- pas utile, ou plutôt, à mettre avant la boucle.
                   End If

Et au lieu de faire une boucle sur les lignes, tu ferais mieux de filtrer la colonne N (en gardant OUI), copier-coller tout ce qui résulte du filtre, puis enlever le filtre. Pour filtrer, interesse-toi à Range.AutoFilter.
2. On écrit :

Code:

1
2
3
Rows(1).Delete
'---- ou ----
Range("1:1").Delete

3. Comment construis-tu la boucle For Lign = FinLign To DebLign ?
Quand est-ce que tu dis ce que valent FinLign et DebLign ?
Quand on fait une boucle pour supprimer des lignes, on fait une boucle en sens inverse (Step -1). Dans ton cas, on utilise même plutôt les filtres qu'une boucle. Cf. : https://www.developpez.net/forums/d1...on-lignes-vba/

Bonsoir,

En effet le fait de passer par un filtre me parait très intéressant, par contre je n'arrive plus à copier les valeurs que je veux.

Code:

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
Private Sub CommandButton1_Click()
 
Dim WsE1 As Worksheet, WsSC3 As Worksheet
Dim DernLign As Long, i&, LignCible
 
Set WsE1 = Sheets("EDITION BC")
Set WsSC3 = Sheets("SYNTHESE EN COURS")
 
DernLign = Range("A" & Rows.Count).End(xlUp).Row
LignCible = 6
 
   Range("A5").AutoFilter Field:=15, Criteria1:="OUI"
 
        If Range("O" & i) = "OUI" Then
        Range("C" & i).Copy WsE1.Range("A" & LignCible)
        Range("D" & i).Copy WsE1.Range("B" & LignCible)
        Range("A" & i).Copy WsSC3.Range("A" & LignCible)
        Range("B" & i).Copy WsSC3.Range("B" & LignCible)
        Range("C" & i).Copy WsSC3.Range("C" & LignCible)
        Range("D" & i).Copy WsSC3.Range("D" & LignCible)
        Range("E" & i).Copy WsSC3.Range("E" & LignCible)
        Range("F" & i).Copy WsSC3.Range("F" & LignCible)
        Range("G" & i).Copy WsSC3.Range("G" & LignCible)
        Range("H" & i).Copy WsSC3.Range("H" & LignCible)
        Range("I" & i).Copy WsSC3.Range("I" & LignCible)
        Range("J" & i).Copy WsSC3.Range("J" & LignCible)
        Range("K" & i).Copy WsSC3.Range("K" & LignCible)
        Range("L" & i).Copy WsSC3.Range("L" & LignCible)
        Range("M" & i).Copy WsSC3.Range("M" & LignCible)
        End If
 
        Rows(i).Delete
 
    Range("O" & i).AutoFilter Field:=15
 
End Sub

Me serais-je trompé dans mon code ?

Cordialement.

Citation:

Me serais-je trompé dans mon code ?

Oui ;)
Attention, tu melanges ton ancien code (boucle) avec l'idée du filtre. Le filtre permet de ne pas utiliser de boucle.
Regarde bien ton nouveau code : que vaut i ? Tu ne le définis jamais. Et pour cause : tu n'en as pas besoin !

1. Regardons d'abord la partie "copier-coller"
Quand tu imposes le filtre, tu copies TOUT ce qui résulte du filtre et tu le colles. Pas besoin de copier ligne par ligne. Et surtout pas besoin de vérifier ligne par ligne s'il y a un OUI, puisque tu as filtré sur les OUI !!!

Tu filtres
Tu copies TOUT
Tu colles
Code:

1 2 3 4 5 6 7 8 9 10 Private Sub CommandButton1_Click() [...] DernLign = Range("A" & Rows.Count).End(xlUp).Row LignCible = 6 Range("A5:O" & DernLign).AutoFilter Field:=15, Criteria1:="OUI" '-----> on filtre TOUTE la plage Range("C6:D" & DernLign).Copy WsE1.Range("A6") '------> On recopie TOUTE la plage Range("A6:M" & DernLign).Copy WsSC3.Range("A6") Range("A5:O" & DernLign).AutoFilter Field:=15 End Sub
/!\ Au passage, je te rappelle que copier la colonne A, la coller en colonne A, puis copier la colonne B et la coller en colonne B ... copier la colonne M et la coller en colonne M revient à coiper les colonnes A à M et les coller à partir de la colonne A.

2. Regardons maintenant la suppression de lignes.
Pour supprimer les lignes, pas besoin non plus de le faire ligne par ligne, on le fait avec le filtre aussi ! Une fois qu'on a filtré, on veut supprimer les lignes VISIBLES. On utilise donc la propriété SpecialCells(xlCellTypeVisible)

Code:

Range("A5:O" & DernLign).SpecialCells(xlCellTypeVisible).EntireRow.Delete

Avec cela on supprime toutes les lignes visibles (donc les lignes contenant un OUI, d'après le filtre).
Remarque : Excel est plus rapide lorsqu'il peut supprimer des blocs de lignes. Donc pour rendre ton algorithme plus rapide, avant de filtrer, tu peux trier la colonne O. Ainsi tous les OUI se trouveront les uns en dessous des autres en un bloc.

Tout ceci donne
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Private Sub CommandButton1_Click() Dim WsE1 As Worksheet, WsSC3 As Worksheet Dim DernLign As Long, LignCible Set WsE1 = Sheets("EDITION BC") Set WsSC3 = Sheets("SYNTHESE EN COURS") DernLign = Range("A" & Rows.Count).End(xlUp).Row LignCible = 6 'code pour trier --> à voir avec l'enregistreur de macro Range("A5:O" & DernLign).AutoFilter Field:=15, Criteria1:="OUI" '-----> on filtre TOUTE la plage Range("C6:D" & DernLign).Copy WsE1.Range("A6") '------> On recopie TOUTE la plage Range("A6:M" & DernLign).Copy WsSC3.Range("A6") Range("A5:O" & DernLign).SpecialCells(xlCellTypeVisible).EntireRow.Delete Range("A5:O" & DernLign).AutoFilter Field:=15 End Sub

19/07/2017, 12h38
Kris41

Merci pour cette explication, je comprends mieux ce que je n'arrivais pas à exprimer dans le code. J'essaierais cela ce soir et je vous tiendrais au courant sur la fonctionnalité.

De plus si je veux faire un peu en sort de copier chaque ligne une par une, ce qui est peut-être une erreur c'est parce que le tableau final peut bouger à tout instant après sa mise en fonction. Mais votre code me parait assez simple pour pouvoir le réécrire si il y as besoin.

A bientôt. Cordialement. Et encore merci pour ces explications.
19/07/2017, 18h49
Kris41

Bonsoir,

Je viens de tester le code et seul bémol c'est que j'obtient une erreur : "La méthode Delete de la class Range a échoué".

Je vais essayé de comprendre et de rectifié cette erreur.

Bonne soirée à tous.
Cordialement.
20/07/2017, 07h59
riaolle

Je ne sais pas si ça va résoudre ton problème, mais en fait, tu n'as pas besoin du SpecialCells :

Code:

Range("A5:O" & DernLign).EntireRow.Delete
20/07/2017, 12h44
Kris41

Bonjour,

Oui en effet cela à résolu le problème, par contre le code ne désactive pas le filtre.

De plus, j'ai un autre problème qui est le suivant :

Quand dans la première feuille je mets de nouvelle ligne sous la condition du OUI, celle-ci ne se rajoute pas à la fin des lignes déjà transférées mais les remplace.

En tout cas un grand merci car je comprends de mieux en mieux ce que je fait et je regarde ce soir comment je pourrais amélioré le code afin d'arrivé au résultat final.

Bonne journée.
Cordialement.