ترحيل من ورقة لورقة بناء على شرط

[كمال فايز]

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

Private Sub CommandButton3_Click()
Sheet2.Range("bj8").Value = Me.TextBox148.Text
Dim sahb As Integer
sahb = Sheet2.Range("bk8").Value
Dim answer As VbMsgBoxResult
answer = MsgBox("åá ÊÑíÏ ÓÍÈ ÇáØÇáÈ ÈÇáÝÚá", vbYesNo + vbCritical)
If answer = vbYes Then
listsource
Dim last5 As Integer
last5 = Sheet2.Range("a10000").End(xlUp).Row
Sheet2.Range("a8:bd" & sahb).Copy Sheet6.Range("a8:bd" & last5)
Sheet2.Range("a8:bd" & sahb).Clear
End If
End Sub

اخر بيانات2rr2.xlsm

[r3dx]

Private Sub CommandButton3_Click()
    ' تعيين قيمة TextBox148 إلى الخلية bj8 في Sheet2
    Sheet2.Range("bj8").Value = Me.TextBox148.Text
    
    ' تعيين متغير sahb بقيمة الخلية bk8 في Sheet2
    Dim sahb As Integer
    sahb = Sheet2.Range("bk8").Value
    
    ' عرض رسالة تأكيد للمستخدم
    Dim answer As VbMsgBoxResult
    answer = MsgBox("هل تريد سحب الطلب بالفعل؟", vbYesNo + vbCritical)
    
    If answer = vbYes Then
        ' استدعاء دالة listsource (تأكد من وجود هذه الدالة في الكود)
        listsource
        
        ' الحصول على آخر صف مستخدم في العمود A في Sheet6
        Dim last5 As Integer
        last5 = Sheet6.Range("a10000").End(xlUp).Row
        
        ' نسخ النطاق من A8 إلى BD(sahb) في Sheet2 إلى A8 إلى BD(last5) في Sheet6
        Sheet2.Range("a8:bd" & sahb).Copy Sheet6.Range("a8:bd" & last5 + 1)
        
        ' مسح النطاق المنسوخ من A8 إلى BD(sahb) في Sheet2
        Sheet2.Range("a8:bd" & sahb).Clear
    End If
End Sub