كيفية حل مشكلة تخزين البيانات في الجدول من بدايته وليست من نهايته

[الحسن]

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

والمشكلة هي أنه عند ترحيل البيانات من شيت 1 إلى شيت 2 مكان تخزين البيانات المرحلة والموجود به جدول تم تنسيقه من خلال خاصية إدراج جدول فتكون عملية التخزين من اسف الجدول وليست من بداية الجدول.
أرجو المساعدة في الحل إن تكرمتم علينا
واكون شاكراً لكم فضلكم جزيل الشكر

مرفق الملف

 

gg.xlsmFetching info...

[lionheart]

Sub Test()
    Dim a, ws As Worksheet, sh As Worksheet, i As Long
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set sh = ThisWorkbook.Worksheets("Sheet2")
    With ws
        a = Array(Empty, .Range("C11").Value, .Range("C9").Value, .Range("C6").Value, .Range("C12").Value, .Range("C8").Value)
    End With
    With sh.ListObjects(1)
        For i = 1 To .ListRows.Count
            If Application.CountA(.ListRows(i).Range) = 0 Then Exit For
        Next i
        If i > .ListRows.Count Then .ListRows.Add
        .ListRows(i).Range.Value = a
    End With
End Sub

 

[الحسن]

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

 

[a.kawkab]

السلام عليكم 

اليك اخى الملف بعد التعديل

gg.xlsmFetching info...

[الحسن]

عزيزي لقد قمت بنقل الكود الذي وضعته لنقل بيانات سند الدفع على المشروع الذي أعمل به ولم يعمل معي ولا أعرف ما هو السبب ، لذلك سأرفق لك المشروع الذي أعمل عليه كامل لتعينني في حل هذه الاشكالية، وأكون شاكراً جداً لك لو وضعت لي كود يقوم بالبحث عن بيانات الفاتورة في سجل المشتريات واجراء التعديل عليها.

واعذرني على غلبتي لك 

GHGH.xlsmFetching info...

[a.kawkab]

  في 1‏/11‏/2021 at 12:15, الحسن said:

عزيزي لقد قمت بنقل الكود الذي وضعته لنقل بيانات سند الدفع على المشروع الذي أعمل به ولم يعمل معي ولا أعرف ما هو السبب ، لذلك سأرفق لك المشروع الذي أعمل عليه كامل لتعينني في حل هذه الاشكالية، وأكون شاكراً جداً لك لو وضعت لي كود يقوم بالبحث عن بيانات الفاتورة في سجل المشتريات واجراء التعديل عليها.

واعذرني على غلبتي لك 

GHGH.xlsm 489.45 kB · 2 downloads

Expand  

Sub Pay_Pay1()
Application.ScreenUpdating = False
Sheet6.Activate
Dim ms As Range
Set ms = ActiveSheet.ListObjects("table4").Range
Dim r As Long
r = WorksheetFunction.CountA(Sheets("إجمالي حساب الموردين").Range("C:C"))
r = r + 4
Sheet6.Cells(r, "c").Value = Sheet4.Range("c9").Value
Sheet6.Cells(r, "d").Value = Sheet4.Range("c10").Value
Sheet6.Cells(r, "e").Value = Sheet4.Range("h10").Value
Sheet6.Cells(r, "f").Value = Sheet4.Range("e7").Value
Sheet6.Cells(r, "g").Value = Sheet4.Range("c14").Value
Sheet6.Cells(r, "i").Value = Sheet4.Range("h9").Value
Sheet4.Activate
Sheet4.Range("e7").Value = Sheet4.Range("e7") + 1
Application.ScreenUpdating = True
End Sub

تم تعديل الكود المطلوب

[a.kawkab]

الملف بعد تعديل الكود

GHGH.xlsmFetching info...