Hasso Mohammed

اخي الكريم هذاكود سيساعدكفي الحل وان لم تستطع فساساعدك على ذلك هذه الصنارة 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

الف شكر الف شكر. دمتم ذخرا لنا وللجميع وارجو شاكرا ان تساعد في المواضيع المفتوح بالمنتدي . وجزاكم الله خيرا

السلام عليكم زكاة العتم نشره

جزاك الله كل الخير و ادخلك فسيح جناته

جزاك الله خيرا وربنا يوفقك شكرا على المشاركه الرائعه