Archivage par array suivant condtion

Option Explicit
Sub Archivage()
Dim i&, j&
Dim Plg As Range, PLg_EnTete As Range, C As Range
Dim T_EnTete As Variant, T_Data As Variant, T_Report As Variant
Dim dl As Long
Dim bd As Object
Set bd = Sheets("A") 'définit l'onglet bd
dl = bd.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit derlg col1 onglet bd
Application.ScreenUpdating = False          'désactive mise à jour écran

With Sheets("A")
    Set PLg_EnTete = .Range("B1:B5,F1,H1:H2")
    Set Plg = .Range(.Cells(8, 1), .Cells(.Rows.Count, 2).End(3).Offset(, 6))
    T_EnTete = .Range("A1:H5")
End With

T_Data = Plg
ReDim T_Report(1 To UBound(T_Data, 1), 1 To 30)

For i = LBound(T_Data, 1) To UBound(T_Data, 1)
    T_Report(i, 2) = "=ROW()-1"       'VAL1
    T_Report(i, 3) = CDate(T_EnTete(1, 5))  'VAL3
    T_Report(i, 18) = T_EnTete(4, 5)        'VAL18
    T_Report(i, 19) = T_EnTete(1, 2)        'VAL19
    'si VAL20= 0 et VAL21=0  alors sur feuille B VAL20=vide et VAL21=vide 
    T_Report(i, 20) = CDbl(T_EnTete(3, 2))  'VAL20 
    T_Report(i, 21) = CDbl(T_EnTete(4, 2))  'VAL21
    T_Report(i, 22) = T_EnTete(2, 2)        'VAL22
    T_Report(i, 23) = T_EnTete(5, 2)        'VAL23
    T_Report(i, 24) = T_EnTete(1, 8)        'VAL24
    T_Report(i, 25) = T_EnTete(2, 8)        'VAL25
   
   'On boucle sur les colonnes du tableau T_Report
    j = 1
    T_Report(i, j) = T_Data(i, j + 1)       'VAL1
    j = 4
    T_Report(i, j) = T_Data(i, j - 1)       'VAL4
   j = 7
   T_Report(i, j) = T_Data(i, j - 3)        'VAL7
   j = 9
   T_Report(i, j) = T_Data(i, j - 4)        'VAL9
   j = 15
   T_Report(i, j) = T_Data(i, j - 9)        'VAL15
   j = 16
   T_Report(i, j) = T_Data(i, j - 9)        'VAL16
   j = 17
   T_Report(i, j) = T_Data(i, j - 9)        'VAL17
Next i
Sheets("B").Cells(Rows.Count, 1).End(3)(2).Resize(UBound(T_Report, 1), UBound(T_Report, 2)) = T_Report

Application.ScreenUpdating = True
MsgBox "Terminé!"
End Sub