Bonjour,
Je réalise un code qui va vérifier certaines conditions dans plusieurs onglets dont les données sont classées de façon identiques, seul le nombre de ligne diffère, pour regrouper le résultat sur un onglet "Synthèse".
Je compte le nombre de ligne sur le 1er onglet ainsi que le nombre de ligne dans l'onglet "Synthèse", je réalise ma boucle puis passe au deuxième onglet.
Sur le 2ème onglet, je compte le nombre de ligne de ma feuille ainsi que le nombre de ligne de l'onglet "Synthèse" afin de pouvoir coller les données à la suite de celle obtenues sur l'onglet précédent.
Mon code compte correctement le nombre de ligne pour l'onglet 1 et l'onglet "Synthèse" mais ne recompte pas lorsque je passe sur l'onglet 2 et pour la deuxième fois sur l'onglet "Synthèse".

Voici mon code:
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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
Option Explicit
Sub Suivi_Validation()
Dim sh As Worksheet
Dim STS As Worksheet
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Der1 As Integer
Dim Der2 As Integer
Dim RG As Range
Dim STH As Range
i = 1
k = 1
 
Set STS = ThisWorkbook.Sheets("Synthèse")
Set sh = ThisWorkbook.Sheets(i)
 
Set STH = ThisWorkbook.Sheets("Synthèse").Range("A1")
STH = STH.Offset(0)
 
 
For i = 1 To ThisWorkbook.Worksheets.Count
With STH
Der2 = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
 
 
    If Worksheets(i).Name <> ("Synthèse") Then
    Set RG = ThisWorkbook.Sheets(i).Range("A4")
    RG = RG.Offset(0)
        With sh
        Der1 = .Cells(.Rows.Count, 2).End(xlUp).Row
        End With
 
            For j = 0 To Der1 - 4
 
                If RG.Offset(j, 11) <> "" And RG.Offset(j, 18) = "" And (RG.Offset(j, 11).Value - RG.Offset(j, 9).Value) >= 3 Then
                    If STH.Offset(k, 1) = "" Then
                    STH.Offset(k, 0) = RG.Offset(j, 0)
                    STH.Offset(k, 1) = RG.Offset(j, 1)
                    STH.Offset(k, 2) = RG.Offset(j, 2)
                    STH.Offset(k, 3) = RG.Offset(j, 3)
                    STH.Offset(k, 4) = RG.Offset(j, 4)
                    STH.Offset(k, 5) = RG.Offset(j, 5)
                    STH.Offset(k, 6) = RG.Offset(j, 9)
                    STH.Offset(k, 6).NumberFormat = "[$-410]dd-mm-yyyy;@"
                    STH.Offset(k, 7) = (RG.Offset(j, 11) - RG.Offset(j, 9)) & " jours de retard"
                    Else
                    k = Der2
                    STH.Offset(k, 0) = RG.Offset(j, 0)
                    STH.Offset(k, 1) = RG.Offset(j, 1)
                    STH.Offset(k, 2) = RG.Offset(j, 2)
                    STH.Offset(k, 3) = RG.Offset(j, 3)
                    STH.Offset(k, 4) = RG.Offset(j, 4)
                    STH.Offset(k, 5) = RG.Offset(j, 5)
                    STH.Offset(k, 6) = RG.Offset(j, 9)
                    STH.Offset(k, 6).NumberFormat = "[$-410]dd-mm-yyyy;@"
                    STH.Offset(k, 7) = (RG.Offset(j, 11) - RG.Offset(j, 9)) & " jours de retard"
                    End If
                End If
 
                If STH.Offset(k, 0) = "" Then
                     k = k
                Else
                     k = k + 1
                End If
            Next j
    End If
 
Next i
End Sub
Sub Suivi_Validation2()
Dim sh As Worksheet
Dim STS As Worksheet
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Der1 As Integer
Dim Der2 As Integer
Dim RG As Range
Dim STH As Range
i = 1
k = 1
 
Set STS = ThisWorkbook.Sheets("Synthèse")
Set sh = ThisWorkbook.Sheets(i)
 
Set STH = ThisWorkbook.Sheets("Synthèse").Range("A1")
STH = STH.Offset(0)
 
 
For i = 1 To ThisWorkbook.Worksheets.Count
 
    With STH
    Der2 = .Cells(.Rows.Count, 2).End(xlUp).Row
    End With
 
 
    If Worksheets(i).Name <> ("Synthèse") Then
    Set RG = ThisWorkbook.Sheets(i).Range("A4")
    RG = RG.Offset(0)
        With sh
        Der1 = .Cells(.Rows.Count, 2).End(xlUp).Row
        End With
 
            For j = 0 To Der1 - 4
 
                If RG.Offset(j, 11) <> "" And RG.Offset(j, 18) = "" And (RG.Offset(j, 11).Value - RG.Offset(j, 9).Value) >= 3 Then
                    If STH.Offset(k, 1) = "" Then
                    STH.Offset(k, 0) = RG.Offset(j, 0)
 
                    Else
                    k = Der2
                    STH.Offset(k, 0) = RG.Offset(j, 0)
 
                    End If
                End If
 
                If STH.Offset(k, 0) = "" Then
                     k = k
                Else
                     k = k + 1
                End If
            Next j
    End If
 
Next i
End Sub
Quelqu'un a-t-il une idée sur la correction à apporter pour qu'à chaque nouveau passage dans la boucle le nombre de ligne soit recalculé?

Merci pour votre aide et votre collaboration
Eric