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
| Sub Daniel()
Sheets(" BUT").Select
Range("D3:AM8").Select
Selection.ClearContents
Selection.ClearContents
Dim C As Range, Dates() As Long, Ctr As Integer, Col As Integer
Dim Col1 As Integer, BUT As Worksheet, Tabl As Variant, X As Variant
Set BUT = Sheets(" BUT")
Ctr = -1
ReDim Dates(0)
With Sheets("Décalage")
.[IV:IV].ClearContents
For Each C In .Range(.[B7], .Cells(7, .Columns.Count).End(xlToLeft))
If C.Value <> "" And Not IsNumeric(Application.Match(C.Value, Dates, 0)) Then
Ctr = Ctr + 1
ReDim Preserve Dates(Ctr)
Dates(Ctr) = C.Value
End If
Next C
For Each C In .Range(.[B31], .Cells(31, .Columns.Count).End(xlToLeft))
If C.Value <> "" And Not IsNumeric(Application.Match(C.Value, Dates, 0)) Then
Ctr = Ctr + 1
ReDim Preserve Dates(Ctr)
Dates(Ctr) = C.Value
End If
Next C
.[IV1].Resize(UBound(Dates) + 1) = Application.Transpose(Dates)
.[IV1].Resize(UBound(Dates) + 1).Sort .[IV1], xlAscending, Header:=xlNo
Tabl = Application.Transpose(.[IV1].Resize(UBound(Dates) + 1))
.[IV1].Resize(UBound(Dates) + 1).Clear
Col = 1
For Each X In Tabl
If IsNumeric(Application.Match(X, .Rows(7), 0)) Then
'existe dans tableau 1
Col1 = Application.Match(X, .Rows(7), 0)
Col = Col + 3
For i = 3 To 8
If .Cells(i, Col1) <> "" Then
If i = 5 Then
BUT.Cells(i, Col + 1) = .Cells(i, Col1)
Else
BUT.Cells(i, Col) = .Cells(i, Col1)
End If
End If
Next i
End If
'existe dans tableau 2
If IsNumeric(Application.Match(X, .Rows(31), 0)) Then
Col1 = Application.Match(X, .Rows(31), 0)
If IsNumeric(Application.Match(X, BUT.Rows(7), 0)) Then
'existe dans tableau 3
Col = Application.Match(X, BUT.Rows(7), 0)
For i = 27 To 32
If .Cells(i, Col1) <> "" Then
If i = 29 Then
BUT.Cells(i - 24, Col + 1) = .Cells(i, Col1)
Else
BUT.Cells(i - 24, Col) = .Cells(i, Col1)
End If
End If
Next i
Else
Col = Col + 3
For i = 27 To 32
If .Cells(i, Col1) <> "" Then
If i = 29 Then
BUT.Cells(i - 24, Col + 1) = .Cells(i, Col1)
Else
BUT.Cells(i - 24, Col) = .Cells(i, Col1)
End If
End If
Next i
End If
End If
Next X
End With
End Sub |
