المساعدة في ترحيل قيم البيانات من شيت لاخر

[سالي انور]

اخواني الافاضل

اتمني هذه المرة ان يتكرم احد من حضراتكم بالرد

وطلبي هو ترحيل قيم البيانات في الجدول الموجود بشيت المبيعات بدلالة كود الصنف من الخلية q2: Aj10

الي شيت حركة المبيعات بدأ من العمود e2 (لاول خلية فارغة ) علي ان يظهر تنبيه في حالة ادخال الفاتورة مرة اخري

علما بانه يوجد معادلات داخل الجدول واملي في حالة النقل الا يكون هناك صفوف فاصلة بحركة المبيعات

وهذه الحالة فقط هي التي احتاجها لاكمال برنامجي

الله يبارك فيكم وعلمكم الذي اتمني الا تبخلو علينا به

ولكم شكري سلفا

مرفق ملف للايضاح

ترحيل.rar

تم تعديل 20 نوفمبر 2012 بواسطة سالي انور

[وليد صلاح اللقاني]

هذا الطلب يتم تنفيذة عن طريق كتابة اوامر برمجية بداخل وحدات الماكرو فان كان هذا متاح لديك فاعلمينى بهذا ،،،، بالتوفيق

[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