هام : ترحيل واستدعاء بيانات اذن صرف

[عاشق الاكسيل]

السلام عليكم ورحمة الله وبركاته

اساتذتى الاعزاء مطلوب كود لترحيل بيانات اذن الصرف الى صفحة Archive وكود اخر لاستدعائه عن طريق رقم الاذن

Pro.rar

[ياسر خليل أبو البراء]

أخي الكريم ارفق مثال لعملية الترحيل ..ماهي الخلايا التي سيتم ترحيلها؟ وإلى أي ورقة عمل ؟ وأي الأعمدة التي سيتم الترحيل إليها؟

 

 

[عاشق الاكسيل]

سيتم ترحيل الخلايا الاتية :

• نوع الاذن D6
• تاريخ الاذن M2
• المستفيد C10
• مناولة C12
• وذلك قيمة C16
• بيانات القيد B20:K33

مرفق مثال يوضح عملية الترحيل

 

Pro.rar

[ياسر خليل أبو البراء]

أخي الكريم

إليك الكود التالي لعملية الترحيل

يتم الاعتماد على رقم الإذن بحيث يكون غير مكرر في ورقة الأرشيف ... لا يتم الترحيل إذا كانت البيانات غير مكتملة

أرجو أن يفي بالغرض

Sub TransferData()
    Dim WS As Worksheet, SH As Worksheet
    Dim LastRow As Long, LR As Long, I As Long
    Dim Arr, Found

    Set WS = Sheet1: Set SH = Sheet3
    LastRow = WS.Cells(33, "F").End(xlUp).Row
    LR = SH.Cells(Rows.Count, "I").End(xlUp).Row + 1
    Arr = Array("M5", "M2", "D6", "C10", "C12", "C16")

    With Application
        .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False
    End With
        
        For I = 0 To UBound(Arr)
            If IsEmpty(WS.Range(Arr(I))) Or LastRow < 20 Then MsgBox "البيانات غير مكتملة", vbCritical: Exit Sub
        Next I
        
        Set Found = SH.Columns(1).Find(What:=WS.Range("M5").Value, LookAt:=xlWhole)
        If Not Found Is Nothing Then MsgBox "تم ترحيل الإذن من قبل", 64: Exit Sub
        
        For I = 0 To UBound(Arr)
            SH.Cells(LR, I + 1) = WS.Range(Arr(I))
        Next I
        
        WS.Range("P20:R" & LastRow).Copy
        SH.Range("G" & LR).PasteSpecial xlPasteValues
        
    With Application
        .CutCopyMode = False
        .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True
    End With
    
    MsgBox "تم ترحيل البيانات بنجاح", 64
End Sub

تقبل تحياتي

 

Transfer Data Using Arrays YasserKhalil.rar

[عاشق الاكسيل]

استاذى ياسر خليل

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

اكرمك الله فى بيتك وفى اسرتك وفى عملك وفى دنياك وفى اخرتك

الان ناتى الى الجزء الثانى وهو استدعاء بيانات اذن عن طريق رقم الاذن

فى انتظار مشاركتك

[ياسر خليل أبو البراء]

أخي الكريم عاشق الإكسيل

الحمد لله أن تم المطلوب على خير ، وهذا من فضل الله

نصيحة :

من يطارد عصفورين يفقدهما وأكيد إنت عرفت النظام في المنتدى ..قم بطرح موضوع جديد فيما يخص الاستدعاء ليشارك فيه الجميع ..

تقبل تحياتي

[محمد لطفى]

استاذ / ياسر

اخصائى السهل الممتع