اخي الكريم هذاكود سيساعدكفي الحل وان لم تستطع فساساعدك على ذلك
هذه الصنارة
Sub transfert()
Sheets(“Feuil1”).Activate
derligne = Sheets(“Listing”).Range(“A65536”).End(xlUp).Row + 1
If derligne < 2 Then derligne = 2
With Sheets(“Listing”)
If Range(“L2”) = “” Or Range(“A8”) = “” Then MsgBox (“Pas de réf en L2 ou de REF saisi en A8”): Exit Sub
.Range(“A” & derligne) = Format(Range(“C1”), “DD/MM/YYYY”)
.Range(“B” & derligne) = Range(“L2”)
.Range(“C” & derligne) = Range(“J3”)
.Range(“D” & derligne) = Format(Range(“O23”), “#,#0.00”)
col = 5
colonne = Split(Columns(col).Address(ColumnAbsolute:=False), “:”)(1)
For i = 8 To 20
If Range(“A” & i) <> “” Then
.Range(colonne & derligne) = Range(“E” & i): col = col + 1: colonne = Split(Columns(col).Address(ColumnAbsolute:=False), “:”)(1)
.Range(colonne & derligne) = Range(“B” & i) & Range(“C” & i) & Range(“D” & i): col = col + 1: colonne = Split(Columns(col).Address(ColumnAbsolute:=False), “:”)(1)
.Range(colonne & derligne) = Range(“O” & i): col = col + 1: colonne = Split(Columns(col).Address(ColumnAbsolute:=False), “:”)(1)
End If
Next i
col = 1
For i = 7 To 40 Step 3
colonne = Split(Columns(i).Address(ColumnAbsolute:=False), “:”)(1)
.Range(colonne & derligne) = Format(.Range(colonne & derligne), “#,#0.00”)
Next i
End With
End Sub
'd = Range(“C1”).Value
'colonne = Split(Columns(d).Address(ColumnAbsolute:=False), “:”)(1)
'Range(“E1”) = colonne