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
| Sub test()
Dim C As Range, Dat As Date, Plage As Range, Ligne As Long, Col As Integer, DerCol As Integer
Dim Sh As Worksheet, I As Long, J As Long, Ctr1 As Integer, Ctr2 As Integer, Txt As String
Dim Txt1 As String
Ligne = 2
With Sheets("ENTREE")
Set Plage = .[A2].Resize(Application.CountA(.[A:A]) - 1)
End With
Set Sh = Sheets("ENTREE")
With Sheets("SORTIE")
For Each C In Plage
For I = C.Offset(, 2) To C.Offset(, 3)
Ctr1 = 8
Ctr2 = 33
Txt = ""
If (C.Offset(, 11) = 1 And IsNumeric(Application.Match(I * 1, [JOURSFERIES!A:A], 0))) Or _
(Not IsNumeric(Application.Match(I * 1, [JOURSFERIES!A:A], 0)) And _
C.Offset(, Application.Weekday(I, 2) + 3) = 1) Then
' If Not IsNumeric(Application.Match(I * 1, [JOURSFERIES!A:A], 0)) Then
DerCol = C.EntireRow.Find("*", , , , xlByColumns, xlPrevious).Column
Ligne = Ligne + 1
.Cells(Ligne, 1) = C.Value & "-" & C.Offset(, 13).Value & "-" & _
Format(I, "yyyymmdd") & "-" & C.Offset(, 12)
For J = 16 To DerCol
If Sh.Cells(C.Row, J) <> "" Then
If Txt = "" Then
Txt = Sh.Cells(1, J)
.Cells(Ligne, 8) = Sh.Cells(C.Row, J)
End If
Ctr1 = Ctr1 + 1
Ctr2 = Ctr2 + 1
.Cells(Ligne, Ctr1) = Sh.Cells(1, J)
If Sh.Cells(1, J) <> "" Then Txt1 = Sh.Cells(1, J)
.Cells(Ligne, Ctr2) = Sh.Cells(C.Row, J)
End If
Next J
Txt = Txt & " - " & Txt1
.Cells(Ligne, 2) = Txt
.Cells(Ligne, 3) = C.Offset(, 13)
.Cells(Ligne, 4) = C.Offset(, 14)
.Cells(Ligne, 5) = C.Value
.Cells(Ligne, 7) = I
End If
Next I
Next C
End With
End Sub |
Transformer tableau + dupliquer les lignes en fonction des dates
Répondre avec citation
Partager