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