cathodique
XLDnaute Barbatruc
Bonjour à tous,
Je fus aidé pour parvenir à transférer des données sur une autre feuille en utilisant les tableaux et je remercie tous ceux qui m'ont donné un coup de main.
Je voudrai donc compléter ce code pour que si 2 cellules de la feuille source A sont simultanément nulles, les cellules respectives de destination seront vides. Sinon les archiver comme des numériques.
En vous remerciant par avance.
Cordialement,
Je fus aidé pour parvenir à transférer des données sur une autre feuille en utilisant les tableaux et je remercie tous ceux qui m'ont donné un coup de main.
Code:
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
En vous remerciant par avance.
Cordialement,