ترحيل بيانات فاتورة

[seif eldin]

السلام عليكم 

يرجى المساعدة في عمل زر ترحيل بيانات الفاتورة إلى شيت data وهكذا كل فاتورة جديدة

ولكم وافر الشكر والاحترام

برنامج فواتير المبيعات.xlsm

[a.kawkab]

Sub post()
Dim R As Integer
Dim xnewr As Integer

For R = 9 To 24

    If IsEmpty(Cells(R, 2)) Then Exit Sub
'    xnewr = Sheets("Data").Cells(1, 1).CurrentRegion.Rows.Count + 1
    xnewr = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row + 1
    Sheets("Data").Cells(xnewr, 1) = Sheet1.Cells(5, 2)
    Sheets("Data").Cells(xnewr, 2) = Sheet1.Cells(6, 2)
    Sheets("Data").Cells(xnewr, 3) = Sheet1.Cells(5, 9)
    Sheets("Data").Cells(xnewr, 4) = Sheet1.Cells(R, 2)
    Sheets("Data").Cells(xnewr, 5) = Sheet1.Cells(R, 3)
    Sheets("Data").Cells(xnewr, 6) = Sheet1.Cells(R, 4)
    Sheets("Data").Cells(xnewr, 7) = Sheet1.Cells(R, 5)
    Sheets("Data").Cells(xnewr, 8) = Sheet1.Cells(R, 6)
    Sheets("Data").Cells(xnewr, 9) = Sheet1.Cells(R, 7)
    Sheets("Data").Cells(xnewr, 10) = Sheet1.Cells(R, 8)
    Sheets("Data").Cells(xnewr, 11) = Sheet1.Cells(R, 9)
    Sheet1.Range("K9:K24").ClearContents
    Sheet1.Range("f9:f24").ClearContents
    Next
  MsgBox "Êã ÊÑÍíá ÇáÝÇÊæÑÉ", vbInformation, "Done"


End Sub

تم تعديل الكود الخاص بك

[a.kawkab]

يمكنك الاستعانة بهذا الموضوع

null

 

[a.kawkab]

السلام عليكم

اليك اخى الملف بعد التعديل وتنفيذ المطلوب

برنامج فواتير المبيعات.xlsm