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 Totalsemaine()
Dim DerligR1 As Long
Dim DerligR2 As Long
Dim MaPlage As Range
Dim DerniereLigne As Integer
Dim ajout As Integer
Dim nb As Integer
Dim j As Integer
nb = Worksheets.Count
For j = 2 To nb ' - 1
ActiveWorkbook.Worksheets(j).Tab.ColorIndex = 3
ActiveWorkbook.Worksheets(j).Select
ajout = 0
With Sheets("S " & j - 1)
DerligR1 = .Range("b" & .Rows.Count).End(xlUp).Row
End With
With Sheets("Total")
DerligR2 = .Range("a" & .Rows.Count).End(xlUp).Row
Set MaPlage = .Range(.Cells(1, 1), .Cells(DerligR2, 1))
End With
For i = 2 To DerligR1
With MaPlage
Set c = .Find(Sheets("S " & j - 1).Range("b" & i), LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
ajout = ajout + 1
'DerniereLigne = Sheets("Total").Range("a65536").End(xlUp).Row
Sheets("Total").Cells(DerligR2 + ajout, 1) = Sheets("S " & j - 1).Cells(i, 2)
Sheets("Total").Cells(DerligR2 + ajout, 2) = Sheets("S " & j - 1).Cells(i, 13)
Sheets("Total").Cells(DerligR2 + ajout, 3) = Sheets("S " & j - 1).Cells(i, 30)
' With Sheets("S 1")
' .Range(.Cells(DerniereLigne + 1, 2), .Cells(DerniereLigne + 1, 2)).Copy Destination:=Sheets("Total").Cells(i, 1)
' .Range(.Cells(DerniereLigne + 1, 13), .Cells(DerniereLigne + 1, 13)).Copy Destination:=Sheets("Total").Cells(i, 2)
' End With
End If
End With
Next i
Next j
MsgBox ("Fini")
End Sub |
