مطلوب كود ترحيل البيانات من صفحة إلى أخرى بعد التأكد من اكتمالها

[محمد صبره]

السادة الكرام عمالقة هذا المنتدى العظيم

 

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

 

في الملف المرفق يوجد سجل لقيد الحركة اليومية للصندوق وكود لترحيل الحركة من سجل الحركة اليومية إلى سجل الحركة العام .

وما أتمناه هو كود للتأكد من البيانات قبل ترحيلها ((ومعيار الفحص هو الخلية الخاصة بالرصيد التراكمي)) إذا كانت هذه الخلية فارغة فإن هذا يعني أن أحد البيانات غير موجودة ..

لقد قمت بعمل معادلة للرصيد بحيث أنه لن يظهر إلا بعد اكتمال البيانات المطلوبة على مستوى الصفحة وعلى مستوى كل صف على حدة .. والمتبقي هو الكود الذي يفحص خلايا الرصيد الفارغة قبل الترحيل..

 

 

شاكراً لكم سلفاً تعاونكم المستمر والمعتاد...

 

 

أخوكم / محمد صبره

 

Register1.zip

[عبدالله باقشير]

السلام عليكم

 

جرب الكود التالي:

Sub SendDataCash1()
Dim iRow As Long
Dim ws As Worksheet
Dim LR As Integer

LR = WorksheetFunction.Count(Range("K10:K109"))

If LR = 0 Then Exit Sub

Set ws = Worksheets("TRANSACTIONS")
iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

Range("A10:U10").Resize(LR).Copy
ws.Range("A" & iRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("B10").Select
    MsgBox "تم الترحيل"

Set ws = Nothing
End Sub

واشعرنا بالنتيجة

 

تحياتي

[محمد صبره]

استاذي القدير عملاق المنتدى / عبد الله باقشير

 

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

 

لقد قمت بتغيير الكود ولكن واجهتني مشكلة وهي أنه إذا كانت خلية الرصيد الفارغة ليست LR - في هذه الحالة فأنه سوف يتم ترحيلها !

والمطلوب استاذي القدير هو في حالة وجود أي خلية فارغة من خلايا النطاق K10:K109 يقوم الكود بأرسال رسالة ((يرجى التأكد من البيانات الغير مكتملة قبل الترحيل)) ..

والمعيار الاساسي للفحص هو (( إذا كانت الخلايا في النطاق A10:A109 غير فارغة فان خلايا النطاق K10:K109  يجب أن تكون غير فارغة))

 

شاكراً ومقدراً لك التعاون المستمر

وجزاك لله الف خير

 

أخوك / محمد صبره

 

 

Register1.zip

[عبدالله باقشير]

السلام عليكم

 

مادمت اكملت الشروط بالمعادلات نكمل بالمعادلات

اكتب اي حاجة في الخلية  K9  ولو حتى فراغ والغاية ان لاتكون فاضية

 

ثم استبدل المعادلة التالية في الخلية K10 واسحبها على باقي العمود

=IF(OR(K9="";$B$3="";$D$3="";$F$3="";$J$3="";$E$6="";$G$6="";$K$6="";A10="";B10="";C10="";E10="";F10="";G10="";J10="");"";$K$6-SUM($E$10:E10))

هكذا لن يظهر الرصيد في الخلية الا اذا ظهر في الخلية اعلاه

 

والكود لن يرحل الا الرضائد الظاهرة ان وجدت

 

جرب واشعرني بالنتيجة

 

تحياتي

[عبدالله باقشير]

السلام عليكم

 

وهذا التعديل على الكود لاظهار الرسالة المطلوبة

Sub SendDataCash1()
Dim iRow As Long
Dim ws As Worksheet
Dim LR As Integer

LR = WorksheetFunction.Count(Range("K10:K109"))

If LR = 0 Then GoTo 1
If LR <> WorksheetFunction.Count(Range("A10:A109")) Then GoTo 1

Set ws = Worksheets("TRANSACTIONS")
iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

Range("A10:U10").Resize(LR).Copy
ws.Range("A" & iRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("B10").Select
    MsgBox "تم الترحيل"

Set ws = Nothing

Exit Sub
1:
MsgBox "((يرجى التأكد من البيانات الغير مكتملة قبل الترحيل))", vbMsgBoxRight + vbMsgBoxRtlReading

End Sub

وهذا كود آخر بتغيير طريقة الترحيل  للافادة

Sub SendDataCash2()
Dim iRow As Long
Dim ws As Worksheet
Dim LR As Integer

LR = WorksheetFunction.Count(Range("K10:K109"))

If LR = 0 Then GoTo 1
If LR <> WorksheetFunction.Count(Range("A10:A109")) Then GoTo 1

Set ws = Worksheets("TRANSACTIONS")
iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

With Range("A10:U10").Resize(LR)
    ws.Range("A" & iRow).Resize(.Rows.Count, .Columns.Count).Value = .Value
End With

Range("B10").Select
MsgBox "تم الترحيل"

Set ws = Nothing

Exit Sub
1:
MsgBox "((يرجى التأكد من البيانات الغير مكتملة قبل الترحيل))", vbMsgBoxRight + vbMsgBoxRtlReading

End Sub

تحياتي

[محمد صبره]

استاذي القدير / عبد الله باقشير