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
| Sub Tableau()
Dim bd As Object, Fg As Object
Dim DerLig As Long, DerCol As Byte
Dim Tb, RES()
Dim i As Long, j As Long
'''''''''''''''''''''''''''''''''''''''''''
Set bd = Sheets("BD")
DerLig = bd.Cells(Application.Rows.Count, 1).End(xlUp).Row
Set Fg = Sheets("intermediaire")
Application.EnableEvents = False
On Error Resume Next
'Dans la variable tableau Tb on récupère toutes les données de la feuille BD
With bd
DerLig = .Cells(.Rows.Count, 1).End(xlUp).Row
Tb = .Range("A2:R" & DerLig)
End With
With Fg
'on parcours le tableau Tb
For i = 1 To DerLig - 1
'on incrémente le compteur j
j = j + 1
ReDim Preserve RES(1 To 10, 1 To j)
RES(1, j) = Tb(i, 3)
RES(2, j) = Tb(i, 4)
RES(3, j) = Tb(i, 5)
RES(4, j) = Tb(i, 6)
RES(5, j) = Tb(i, 7)
RES(6, j) = Tb(i, 8)
RES(7, j) = Tb(i, 9)
RES(8, j) = Tb(i, 10)
RES(9, j) = Tb(i, 15)
RES(10, j) = Tb(i, 18)
Next i
'on efface la plage de Calcul
DerLig = Fg.Cells(.Rows.Count, 1).End(xlUp).Row
If DerLig > 2 Then .Range("A2:R" & DerLig).Clear
'on transfère le transposé de Res
If j > 0 Then .Range("A2").Resize(j, 10) = Application.Transpose(RES)
End With
Application.ScreenUpdating = True
End Sub |
