Ecriture anormale d’une ligne blanche supplémentaire dans une autre feuille en excel VBA

**alagsar1** · 11/06/2020, 13h26

Bonjour à tous,

Je suis un débutant en vba. J’ai essayé de créer un code lisant en entrée un classeur excel contenant 2 feuilles nommées respectivement ‘ Liste ‘ et ‘ Extraits ‘.

- La 1ère feuille ‘Liste’ contient des données, entre autres :
1 lettre d’identification, 1 N° d’ordre, 4 zones (ventes du matin, de l’après-midi et du soir, puis le cumul de ventes de la journée).

- La 2ème feuille ‘Extraits‘ ne contient rien au départ.

L’objectif, après lecture de chaque enregistrement de la feuille ‘Liste’est :
- d’afficher par MsgBox, les différentes données lues
- de faire la somme des 3 zones de ventes (matin, après-midi et soir)
- de comparer le résultat obtenu et le cumul lu sur l’enregistrement.

- en cas de différence entre ces 2 nombres :
* afficher par MsgBox, pour correction
- sur une ligne, les données de l’enregistrement lu
- sur une autre ligne, ces 2 nombres.
* écrire sur une ligne de la feuille ‘Extraits’ les données de l’enregistrement lu.

- en cas d’égalité entre ces 2 nombres :
* ne rien écrire sur la feuille ‘Extraits’.

Voici ce que j’observe à la fin de l’exécution du code, sur la feuille ‘Extraits’ :
- l’écriture se fait bien lorsqu’il y a différence.
- bizarrement, l’écriture d’une ligne blanche se fait également lorsqu’il y a égalité.

Je voudrais savoir comment procéder pour ne pas écrire une ligne blanche lorsqu’il y a égalité entre le total lu et le total calculé.

Je vous prie de m’aider à résoudre ce problème.

Remerciements.

alagsar1

Je vous envoie ci-après le code utilisé.

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
Sub Testgf02()
Dim w1 As Worksheet
Dim w2 As Worksheet
Dim Ligne As Long
Dim L As Integer
 Dim Ti_1 As String
Dim Nu_1 As String
Dim Da_1 As String
Dim Un_1 As Variant
Dim De_1 As Variant
Dim Tr_1 As Variant
Dim To_1 As Variant
Dim Tot As Variant
Dim Cpt As Integer
Workbooks.Open Filename:="E:\Testgf02.xls"
 Set w1 = Worksheets("Liste")
Set w2 = Worksheets("Extraits")
Ligne = w1.Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
For L = 2 To Ligne
      w2.Select
Ti_1 = w1.Cells(L, 1)
Nu_1 = w1.Cells(L, 2)
Da_1 = w1.Cells(L, 3)
Un_1 = w1.Cells(L, 4)
De_1 = w1.Cells(L, 5)
Tr_1 = w1.Cells(L, 6)
To_1 = w1.Cells(L, 7)
Tot = Un_1 + De_1 + Tr_1
Cpt = 0
'----------Test sur To_1   &   Tot------------
 
If To_1 <> Tot Then
          MsgBox "--> Fin Ligne N° " & L & " : " & Ti_1 & ", " & Nu_1 & "," & Da_1 & "," & Un_1 & "," & De_1 & "," & Tr_1 & " --- Anomalie ---"
          MsgBox "   --> Anomalie / Ligne N° " & L & " :  -- Total lu = " & To_1 & " :     -- Total calculé = " & Tot & " "                           
                                     Cpt = 1
                                     w2.Range("C" & L).Value = w1.Cells(L, 1)
                                     w2.Range("C" & L).Value = w1.Cells(L, 1)
                                     w2.Range("D" & L).Value = w1.Cells(L, 2)
                                     w2.Range("E" & L).Value = w1.Cells(L, 3)
                                     w2.Range("F" & L).Value = w1.Cells(L, 4)
                                     w2.Range("G" & L).Value = w1.Cells(L, 5)
                                     w2.Range("H" & L).Value = w1.Cells(L, 6)
                                     w2.Range("I" & L).Value = w1.Cells(L, 7)
                                     w2.Range("J" & L).Value = Tot
                                     w2.Range("K" & L).Value = " Faux "
                                     Sheets("Extraits").Select
                                     w2.Cells.Select
                                     Application.CutCopyMode = False
                                     w2.Cells.Copy
                                     Worksheets(Worksheets.Count).Select
                                     Cells.Select
                                     ActiveSheet.Paste
          Else
          Cpt = 0
End If
  Tot = 0
  Cpt = 0
  Next L
Application.ScreenUpdating = True
End Sub

**mfoxy** · 11/06/2020, 15h55

Bonjour,

Pour une meilleur compréhension du code fournis.
Pourriez-vous placer votre code entre les balises de rigueur et indenter celui-ci pour une meilleure lisibilité.

Bav,
MFoxy

**alagsar1** · 11/06/2020, 17h58

Bonjour MFoxy,

Voici le code avec les balises de rigueur.

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
 
Sub Testgf02()
Dim w1 As Worksheet
Dim w2 As Worksheet
Dim Ligne As Long
Dim L As Integer
 Dim Ti_1 As String
Dim Nu_1 As String
Dim Da_1 As String
Dim Un_1 As Variant
Dim De_1 As Variant
Dim Tr_1 As Variant
Dim To_1 As Variant
Dim Tot As Variant
Dim Cpt As Integer
Workbooks.Open Filename:="E:\Testgf02.xls"
 Set w1 = Worksheets("Liste")
Set w2 = Worksheets("Extraits")
Ligne = w1.Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
For L = 2 To Ligne
      w2.Select
Ti_1 = w1.Cells(L, 1)
Nu_1 = w1.Cells(L, 2)
Da_1 = w1.Cells(L, 3)
Un_1 = w1.Cells(L, 4)
De_1 = w1.Cells(L, 5)
Tr_1 = w1.Cells(L, 6)
To_1 = w1.Cells(L, 7)
Tot = Un_1 + De_1 + Tr_1
Cpt = 0
'----------Test sur To_1   &   Tot------------
 
If To_1 <> Tot Then
          MsgBox "--> Fin Ligne N° " & L & " : " & Ti_1 & ", " & Nu_1 & "," & Da_1 & "," & Un_1 & "," & De_1 & "," & Tr_1 & " --- Anomalie ---"
          MsgBox "   --> Anomalie / Ligne N° " & L & " :  -- Total lu = " & To_1 & " :     -- Total calculé = " & Tot & " "                           
                                     Cpt = 1
                                     w2.Range("C" & L).Value = w1.Cells(L, 1)
                                     w2.Range("C" & L).Value = w1.Cells(L, 1)
                                     w2.Range("D" & L).Value = w1.Cells(L, 2)
                                     w2.Range("E" & L).Value = w1.Cells(L, 3)
                                     w2.Range("F" & L).Value = w1.Cells(L, 4)
                                     w2.Range("G" & L).Value = w1.Cells(L, 5)
                                     w2.Range("H" & L).Value = w1.Cells(L, 6)
                                     w2.Range("I" & L).Value = w1.Cells(L, 7)
                                     w2.Range("J" & L).Value = Tot
                                     w2.Range("K" & L).Value = " Faux "
                                     Sheets("Extraits").Select
                                     w2.Cells.Select
                                     Application.CutCopyMode = False
                                     w2.Cells.Copy
                                     Worksheets(Worksheets.Count).Select
                                     Cells.Select
                                     ActiveSheet.Paste
          Else
          Cpt = 0
End If
  Tot = 0
  Cpt = 0
  Next L
Application.ScreenUpdating = True
End Sub

**mfoxy** · 11/06/2020, 19h20

Bonsoir,

Le L dans ton code représente la ligne en cours sur ton Wb source.

L est incrémenter à chaque passage dans la boucle, si condition remplie, la macro rempli la ligne L de la feuille cible, donc même numéro de ligne que celle en cours dans l'onglet source.

SI la condition est non remplie, tu passes à un L suivant pour test dans le Wb source et donc aussi en écriture dans cible.

Tu devrais, selon moi, récupéré le numéro de la ligne de la première cellule vidd de cible pour y ajouter tes données dans ta boucle, et changer le L cible par cette variable.

J'espère avoir été assez explicite dans mes explications pour être compris

Bat

**alagsar1** · 11/06/2020, 23h15

Bonjour mfoxy,

Comme vous l'avez proposé, j'ai utilisé M et non plus L pour gérer les lignes à écrire dans la feuille 'Extraits'.
Ainsi, j'incrémente M dans la boucle au moment où cpt = 1, c'est à dire lorsqu'il y a une différence entre le total lu et le total calculé.
A l'exécution du code, tout se passe bien. Les enregistrements qui vérifient cette condition sont donc écrits sur des lignes qui se suivent.

Je vous remercie infiniment pour l'aide précieuse que vous m'avez apportée.

A bientôt.

alagsar1

**alagsar1** · 11/06/2020, 23h21

Bonjour mfoxy,

Comme vous l'avez proposé, j'utilise maintenant M et non plus L pour gérer les lignes à écrire dans la feuille 'Extraits'.
Ainsi, j'incrémente M dans la boucle au moment où cpt = 1, c'est à dire lorsqu'il y a une différence entre le total lu et le total calculé.
A l'exécution du code, tout se passe bien. Les enregistrements qui vérifient cette condition sont donc écrits sur des lignes qui se suivent.

Je vous remercie infiniment pour l'aide précieuse que vous m'avez apportée.

A bientôt.

alagsar1

Ecriture anormale d’une ligne blanche supplémentaire dans une autre feuille en excel VBA

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager