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 |
Partager